Mercurial > hg > CbC > CbC_gcc

annotate gcc/testsuite/gfortran.dg/inquiry_type_ref_1.f08 @ 152:2b5abeee2509

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
update gcc11
author anatofuz
date Mon, 25 May 2020 07:50:57 +0900
parents 1830386684a0
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
145
1830386684a0 gcc-9.2.0
anatofuz
parents:
diff changeset
1 ! { dg-do run }
1830386684a0 gcc-9.2.0
anatofuz
parents:
diff changeset
2 !
1830386684a0 gcc-9.2.0
anatofuz
parents:
diff changeset
3 ! Test the implementation of inquiry part references (PR40196).
1830386684a0 gcc-9.2.0
anatofuz
parents:
diff changeset
4 ! "Type parameter inquiry (str%len, a%kind) and Complex parts (z%re, z%im)"
1830386684a0 gcc-9.2.0
anatofuz
parents:
diff changeset
5 !
1830386684a0 gcc-9.2.0
anatofuz
parents:
diff changeset
6 ! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
1830386684a0 gcc-9.2.0
anatofuz
parents:
diff changeset
7 !
1830386684a0 gcc-9.2.0
anatofuz
parents:
diff changeset
8 module m
1830386684a0 gcc-9.2.0
anatofuz
parents:
diff changeset
9 complex, target :: z
1830386684a0 gcc-9.2.0
anatofuz
parents:
diff changeset
10 character (:), allocatable :: str
1830386684a0 gcc-9.2.0
anatofuz
parents:
diff changeset
11 real, pointer :: r => z%re
1830386684a0 gcc-9.2.0
anatofuz
parents:
diff changeset
12 real, pointer :: i => z%im
1830386684a0 gcc-9.2.0
anatofuz
parents:
diff changeset
13 type :: mytype
1830386684a0 gcc-9.2.0
anatofuz
parents:
diff changeset
14 complex :: z = ( 10.0, 11.0 )
1830386684a0 gcc-9.2.0
anatofuz
parents:
diff changeset
15 character(6) :: str
1830386684a0 gcc-9.2.0
anatofuz
parents:
diff changeset
16 end type
1830386684a0 gcc-9.2.0
anatofuz
parents:
diff changeset
17 end module
1830386684a0 gcc-9.2.0
anatofuz
parents:
diff changeset
18
1830386684a0 gcc-9.2.0
anatofuz
parents:
diff changeset
19 use m
1830386684a0 gcc-9.2.0
anatofuz
parents:
diff changeset
20
1830386684a0 gcc-9.2.0
anatofuz
parents:
diff changeset
21 type(mytype) :: der
1830386684a0 gcc-9.2.0
anatofuz
parents:
diff changeset
22 integer :: j
1830386684a0 gcc-9.2.0
anatofuz
parents:
diff changeset
23 character (len=der%str%len) :: str1
1830386684a0 gcc-9.2.0
anatofuz
parents:
diff changeset
24 complex, parameter :: zc = ( 99.0, 199.0 )
1830386684a0 gcc-9.2.0
anatofuz
parents:
diff changeset
25 REAL, parameter :: rc = zc%re
1830386684a0 gcc-9.2.0
anatofuz
parents:
diff changeset
26 REAL, parameter :: ic = zc%im
1830386684a0 gcc-9.2.0
anatofuz
parents:
diff changeset
27
1830386684a0 gcc-9.2.0
anatofuz
parents:
diff changeset
28 z = (2.0,4.0)
1830386684a0 gcc-9.2.0
anatofuz
parents:
diff changeset
29 str = "abcd"
1830386684a0 gcc-9.2.0
anatofuz
parents:
diff changeset
30
1830386684a0 gcc-9.2.0
anatofuz
parents:
diff changeset
31 ! Check the pointer initializations
1830386684a0 gcc-9.2.0
anatofuz
parents:
diff changeset
32 if (r .ne. real (z)) stop 1
1830386684a0 gcc-9.2.0
anatofuz
parents:
diff changeset
33 if (i .ne. imag (z)) stop 2
1830386684a0 gcc-9.2.0
anatofuz
parents:
diff changeset
34
1830386684a0 gcc-9.2.0
anatofuz
parents:
diff changeset
35 ! Check the use of inquiry part_refs on lvalues and rvalues.
1830386684a0 gcc-9.2.0
anatofuz
parents:
diff changeset
36 z%im = 4.0 * z%re
1830386684a0 gcc-9.2.0
anatofuz
parents:
diff changeset
37
1830386684a0 gcc-9.2.0
anatofuz
parents:
diff changeset
38 ! Check that the result is OK.
1830386684a0 gcc-9.2.0
anatofuz
parents:
diff changeset
39 if (z%re .ne. real (z)) stop 3
1830386684a0 gcc-9.2.0
anatofuz
parents:
diff changeset
40 if (abs (z*im - 4.0 * real (z)) .lt. 1e-6) stop 4
1830386684a0 gcc-9.2.0
anatofuz
parents:
diff changeset
41
1830386684a0 gcc-9.2.0
anatofuz
parents:
diff changeset
42 ! Check a double inquiry part_ref.
1830386684a0 gcc-9.2.0
anatofuz
parents:
diff changeset
43 if (z%im%kind .ne. kind (z)) stop 5
1830386684a0 gcc-9.2.0
anatofuz
parents:
diff changeset
44
1830386684a0 gcc-9.2.0
anatofuz
parents:
diff changeset
45 ! Test on deferred character length.
1830386684a0 gcc-9.2.0
anatofuz
parents:
diff changeset
46 if (str%kind .ne. kind (str)) stop 6
1830386684a0 gcc-9.2.0
anatofuz
parents:
diff changeset
47 if (str%len .ne. len (str)) stop 7
1830386684a0 gcc-9.2.0
anatofuz
parents:
diff changeset
48
1830386684a0 gcc-9.2.0
anatofuz
parents:
diff changeset
49 ! Check the use in specification expressions.
1830386684a0 gcc-9.2.0
anatofuz
parents:
diff changeset
50 if (len (der%str) .ne. LEN (str1)) stop 8
1830386684a0 gcc-9.2.0
anatofuz
parents:
diff changeset
51 if (rc .ne. real (zc)) stop 9
1830386684a0 gcc-9.2.0
anatofuz
parents:
diff changeset
52 if (ic .ne. aimag (zc)) stop 10
1830386684a0 gcc-9.2.0
anatofuz
parents:
diff changeset
53
1830386684a0 gcc-9.2.0
anatofuz
parents:
diff changeset
54 end
1830386684a0 gcc-9.2.0
anatofuz
parents:
diff changeset
55