2017-02-20 Paul Thomas <pault@gcc.gnu.org>
[official-gcc.git] / gcc / testsuite / gfortran.dg / character_array_constructor_1.f90
blobac0f7e315df7f2694494f40ed39fba53c1a0c9ab
1 ! { dg-do run }
2 ! Tests the fix for PR27113, in which character structure
3 ! components would produce the TODO compilation error "complex
4 ! character array constructors".
6 ! Test based on part of tonto-2.2;
7 ! Contributed by Paul Thomas <pault@gcc.gnu.org>
9 type BASIS_TYPE
10 character(len=8) :: label
11 end type
13 type(BASIS_TYPE), dimension(:), pointer :: ptr
14 character(8), dimension(2) :: carray
16 allocate (ptr(2))
17 ptr(1)%label = "Label 1"
18 ptr(2)%label = "Label 2"
20 ! This is the original bug
21 call read_library_data_((/ptr%label/))
23 carray(1) = "Label 3"
24 carray(2) = "Label 4"
26 ! Mix a character array with the character component of a derived type pointer array.
27 call read_library_data_((/carray, ptr%label/))
29 ! Finally, add a constant (character(8)).
30 call read_library_data_((/carray, ptr%label, "Label 5 "/))
32 contains
34 subroutine read_library_data_ (chr)
35 character(*), dimension(:) :: chr
36 character(len = len(chr)) :: tmp
37 if (size(chr,1) == 2) then
38 if (any (chr .ne. (/"Label 1", "Label 2"/))) call abort ()
39 elseif (size(chr,1) == 4) then
40 if (any (chr .ne. (/"Label 3", "Label 4","Label 1", "Label 2"/))) call abort ()
41 elseif (size(chr,1) == 5) then
42 if (any (chr .ne. (/"Label 3", "Label 4","Label 1", "Label 2", "Label 5"/))) &
43 call abort ()
44 end if
45 end subroutine read_library_data_
47 end