]> git.ipfire.org Git - thirdparty/binutils-gdb.git/blame - gdb/testsuite/gdb.fortran/derived-type-function.f90
Update copyright year range in header of all files managed by GDB
[thirdparty/binutils-gdb.git] / gdb / testsuite / gdb.fortran / derived-type-function.f90
CommitLineData
1d506c26 1! Copyright 2016-2024 Free Software Foundation, Inc.
04d59df6
WT
2!
3! This program is free software; you can redistribute it and/or modify
4! it under the terms of the GNU General Public License as published by
5! the Free Software Foundation; either version 3 of the License, or
6! (at your option) any later version.
7!
8! This program is distributed in the hope that it will be useful,
9! but WITHOUT ANY WARRANTY; without even the implied warranty of
10! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
11! GNU General Public License for more details.
12!
13! You should have received a copy of the GNU General Public License
14! along with this program. If not, see <http://www.gnu.org/licenses/>.
15!
16! This file is the Fortran source file for derived-type-function.exp.
17! It was contributed by Walfred Tedeschi (walfred.tedeschi@intel.com).
18
19module class_Rectangle
20 implicit none
21 private
22
23 type, public :: Rectangle
24 real :: a
25 real :: b
26 contains
27 procedure :: area => rectangle_area
28 procedure :: print_area => print_area
29 end type Rectangle
30contains
31
32 function rectangle_area (this) result (area)
33 class (Rectangle), intent (in) :: this
34
35 real :: area
36 area = this%a * this%b
37 end function rectangle_area
38
39 subroutine print_area (this)
40 class (Rectangle), intent (in) :: this
41 real :: area
42
43 area = this%area ()
44 print *, ' area = ', area
45 end subroutine print_area
46
47end module class_Rectangle
48
49
50program rectangle_Test
51 use class_Rectangle
52 implicit none
53
54 type (Rectangle) :: aRec
55 real areaE
56
57 aRec = Rectangle (2., 3.)
58 ! bp
59 call aRec%print_area
60
61end program rectangle_Test
62