annotate gcc/testsuite/gfortran.dg/function_kinds_4.f90 @ 158:494b0b89df80 default tip

...
author Shinji KONO <kono@ie.u-ryukyu.ac.jp>
date Mon, 25 May 2020 18:13:55 +0900
parents 84e7813d76e9
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
111
kono
parents:
diff changeset
1 ! { dg-do run }
kono
parents:
diff changeset
2 ! Tests the fix for PR34471 in which function KINDs that were
kono
parents:
diff changeset
3 ! USE associated would cause an error.
kono
parents:
diff changeset
4 !
kono
parents:
diff changeset
5 ! This only needs to be run once.
kono
parents:
diff changeset
6 ! { dg-options "-O2" }
kono
parents:
diff changeset
7 !
kono
parents:
diff changeset
8 ! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
kono
parents:
diff changeset
9 !
kono
parents:
diff changeset
10 module m1
kono
parents:
diff changeset
11 integer, parameter :: i1 = 1, i2 = 2
kono
parents:
diff changeset
12 end module m1
kono
parents:
diff changeset
13
kono
parents:
diff changeset
14 module m2
kono
parents:
diff changeset
15 integer, parameter :: i1 = 8
kono
parents:
diff changeset
16 end module m2
kono
parents:
diff changeset
17
kono
parents:
diff changeset
18 integer(i1) function three()
kono
parents:
diff changeset
19 use m1, only: i2
kono
parents:
diff changeset
20 use m2 ! This provides the function kind
kono
parents:
diff changeset
21 three = i1
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
22 if(three /= kind(three)) STOP 1
111
kono
parents:
diff changeset
23 end function three
kono
parents:
diff changeset
24
kono
parents:
diff changeset
25 ! At one stage during the development of the patch, this started failing
kono
parents:
diff changeset
26 ! but was not tested in gfortran.dg. */
kono
parents:
diff changeset
27 real (kind(0d0)) function foo ()
kono
parents:
diff changeset
28 foo = real (kind (foo))
kono
parents:
diff changeset
29 end function
kono
parents:
diff changeset
30
kono
parents:
diff changeset
31 program main
kono
parents:
diff changeset
32 implicit none
kono
parents:
diff changeset
33 interface
kono
parents:
diff changeset
34 integer(8) function three()
kono
parents:
diff changeset
35 end function three
kono
parents:
diff changeset
36 end interface
kono
parents:
diff changeset
37 integer, parameter :: i1 = 4
kono
parents:
diff changeset
38 integer :: i
kono
parents:
diff changeset
39 real (kind(0d0)) foo
kono
parents:
diff changeset
40 i = one()
kono
parents:
diff changeset
41 i = two()
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
42 if(three() /= 8) STOP 2
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
43 if (int(foo()) /= 8) STOP 3
111
kono
parents:
diff changeset
44 contains
kono
parents:
diff changeset
45 integer(i1) function one() ! Host associated kind
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
46 if (kind(one) /= 4) STOP 4
111
kono
parents:
diff changeset
47 one = 1
kono
parents:
diff changeset
48 end function one
kono
parents:
diff changeset
49 integer(i1) function two() ! Use associated kind
kono
parents:
diff changeset
50 use m1, only: i2
kono
parents:
diff changeset
51 use m2
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
52 if (kind(two) /= 8) STOP 5
111
kono
parents:
diff changeset
53 two = 1
kono
parents:
diff changeset
54 end function two
kono
parents:
diff changeset
55 end program main