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