2 ! Test (re)allocation on assignment of scalars
4 ! Contributed by Paul Thomas <pault@gcc.gnu.org>
10 call test_deferred_char1
11 call test_deferred_char4
14 real, allocatable :: x
22 subroutine test_derived
27 type (mytype), allocatable :: t
28 t = mytype (99.0, "abcd")
29 if (t%c .ne. "abcd") STOP 3
32 character(len = 8), allocatable :: c1
33 character(len = 8) :: c2 = "abcd1234"
35 if (c1 .ne. c2) STOP 4
38 if (c1 .ne. c2) STOP 5
41 character(len = 8, kind = 4), allocatable :: c1
42 character(len = 8, kind = 4) :: c2 = 4_"abcd1234"
44 if (c1 .ne. c2) STOP 6
47 if (c1 .ne. c2) STOP 7
49 subroutine test_deferred_char1
50 character(:), allocatable :: c
52 if (c .ne. "Hello") STOP 8
53 if (len(c) .ne. 5) STOP 9
55 if (c .ne. "Goodbye") STOP 10
56 if (len(c) .ne. 7) STOP 11
57 ! Check that the hidden LEN dummy is passed by reference
59 if (c .ne. "Made in test!") print *, c
60 if (len(c) .ne. 13) STOP 12
62 subroutine test_pass_c1 (carg)
63 character(:), allocatable :: carg
64 if (carg .ne. "Goodbye") STOP 13
65 if (len(carg) .ne. 7) STOP 14
66 carg = "Made in test!"
68 subroutine test_deferred_char4
69 character(:, kind = 4), allocatable :: c
71 if (c .ne. 4_"Hello") STOP 15
72 if (len(c) .ne. 5) STOP 16
74 if (c .ne. 4_"Goodbye") STOP 17
75 if (len(c) .ne. 7) STOP 18
76 ! Check that the hidden LEN dummy is passed by reference
78 if (c .ne. 4_"Made in test!") print *, c
79 if (len(c) .ne. 13) STOP 19
81 subroutine test_pass_c4 (carg)
82 character(:, kind = 4), allocatable :: carg
83 if (carg .ne. 4_"Goodbye") STOP 20
84 if (len(carg) .ne. 7) STOP 21
85 carg = 4_"Made in test!"