1! { dg-do run }
2! Test (re)allocation on assignment of scalars
3!
4! Contributed by Paul Thomas  <pault@gcc.gnu.org>
5!
6  call test_real
7  call test_derived
8  call test_char1
9  call test_char4
10  call test_deferred_char1
11  call test_deferred_char4
12contains
13  subroutine test_real
14    real, allocatable :: x
15    real :: y = 42
16    x = 42.0
17    if (x .ne. y) STOP 1
18    deallocate (x)
19    x = y
20    if (x .ne. y) STOP 2
21  end subroutine
22  subroutine test_derived
23    type :: mytype
24      real :: x
25      character(4) :: c
26    end type
27    type (mytype), allocatable :: t
28    t = mytype (99.0, "abcd")
29    if (t%c .ne. "abcd") STOP 3
30  end subroutine
31  subroutine test_char1
32    character(len = 8), allocatable :: c1
33    character(len = 8) :: c2 = "abcd1234"
34    c1 = "abcd1234"
35    if (c1 .ne. c2) STOP 4
36    deallocate (c1)
37    c1 = c2
38    if (c1 .ne. c2) STOP 5
39  end subroutine
40  subroutine test_char4
41    character(len = 8, kind = 4), allocatable :: c1
42    character(len = 8, kind = 4) :: c2 = 4_"abcd1234"
43    c1 = 4_"abcd1234"
44    if (c1 .ne. c2) STOP 6
45    deallocate (c1)
46    c1 = c2
47    if (c1 .ne. c2) STOP 7
48  end subroutine
49  subroutine test_deferred_char1
50    character(:), allocatable :: c
51    c = "Hello"
52    if (c .ne. "Hello") STOP 8
53    if (len(c) .ne. 5) STOP 9
54    c = "Goodbye"
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
58    call test_pass_c1 (c)
59    if (c .ne. "Made in test!") print *, c
60    if (len(c) .ne. 13) STOP 12
61  end subroutine
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!"
67  end subroutine
68  subroutine test_deferred_char4
69    character(:, kind = 4), allocatable :: c
70    c = 4_"Hello"
71    if (c .ne. 4_"Hello") STOP 15
72    if (len(c) .ne. 5) STOP 16
73    c = 4_"Goodbye"
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
77    call test_pass_c4 (c)
78    if (c .ne. 4_"Made in test!") print *, c
79    if (len(c) .ne. 13) STOP 19
80  end subroutine
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!"
86  end subroutine
87end
88
89