diff options
Diffstat (limited to 'gcc/testsuite')
19 files changed, 986 insertions, 0 deletions
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 585839c..aab13e4 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,25 @@ +2016-05-07 Fritz Reese <fritzoreese@gmail.com> + + PR fortran/56226 + * gfortran.dg/dec_structure_1.f90: New testcase. + * gfortran.dg/dec_structure_2.f90: Ditto. + * gfortran.dg/dec_structure_3.f90: Ditto. + * gfortran.dg/dec_structure_4.f90: Ditto. + * gfortran.dg/dec_structure_5.f90: Ditto. + * gfortran.dg/dec_structure_6.f90: Ditto. + * gfortran.dg/dec_structure_7.f90: Ditto. + * gfortran.dg/dec_structure_8.f90: Ditto. + * gfortran.dg/dec_structure_9.f90: Ditto. + * gfortran.dg/dec_structure_10.f90: Ditto. + * gfortran.dg/dec_structure_11.f90: Ditto. + * gfortran.dg/dec_union_1.f90: Ditto. + * gfortran.dg/dec_union_2.f90: Ditto. + * gfortran.dg/dec_union_3.f90: Ditto. + * gfortran.dg/dec_union_4.f90: Ditto. + * gfortran.dg/dec_union_5.f90: Ditto. + * gfortran.dg/dec_union_6.f90: Ditto. + * gfortran.dg/dec_union_7.f90: Ditto. + 2016-05-07 Tom de Vries <tom@codesourcery.com> PR tree-optimization/70956 diff --git a/gcc/testsuite/gfortran.dg/dec_structure_1.f90 b/gcc/testsuite/gfortran.dg/dec_structure_1.f90 new file mode 100644 index 0000000..4dfee3c6 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/dec_structure_1.f90 @@ -0,0 +1,56 @@ +! { dg-do run } +! { dg-options "-fdec-structure" } +! +! Basic STRUCTURE test. +! + +subroutine aborts (s) + character(*), intent(in) :: s + print *, s + call abort() +end subroutine + +! Basic structure +structure /s1/ ! type s1 + integer i1 + logical l1 + real r1 + character c1 +end structure ! end type s1 + +record /s1/ r1 ! type (s1) r1 +record /s1/ r1_a(3) ! type (s1) r1_a(3) + +! Basic records +r1.i1 = 13579 ! r1%i1 = ... +r1.l1 = .true. +r1.r1 = 13.579 +r1.c1 = 'F' +r1_a(2) = r1 +r1_a(3).r1 = 135.79 + +if (r1.i1 .ne. 13579) then + call aborts("r1.i1") +endif + +if (r1.l1 .neqv. .true.) then + call aborts("r1.l1") +endif + +if (r1.r1 .ne. 13.579) then + call aborts("r1.r1") +endif + +if (r1.c1 .ne. 'F') then + call aborts("r1.c1") +endif + +if (r1_a(2).i1 .ne. 13579) then + call aborts("r1_a(2).i1") +endif + +if (r1_a(3).r1 .ne. 135.79) then + call aborts("r1_a(3).r1") +endif + +end diff --git a/gcc/testsuite/gfortran.dg/dec_structure_10.f90 b/gcc/testsuite/gfortran.dg/dec_structure_10.f90 new file mode 100644 index 0000000..2d92b1a --- /dev/null +++ b/gcc/testsuite/gfortran.dg/dec_structure_10.f90 @@ -0,0 +1,119 @@ +! { dg-do run } +! { dg-options "-fdec-structure" } +! +! Runtime tests for rules governing dot ('.') as a member accessor, including +! voodoo with aliased user-defined vs. intrinsic operators and nested members. +! See gcc/fortran/match.c (gfc_match_member_sep). +! + +module dec_structure_10 + ! Operator overload tests with .ne. and constant member + structure /s1/ + integer i + integer ne + logical b + end structure + + ! Operator overload tests with .eq., .test. and nested members + structure /s2/ + record /s1/ eq + record /s1/ test + record /s1/ and + integer i + end structure + + ! Deep nested access tests + structure /s3/ + record /s2/ r2 + end structure + structure /s4/ + record /s3/ r3 + end structure + structure /s5/ + record /s4/ r4 + end structure + structure /s6/ + record /s5/ r5 + end structure + structure /s7/ + record /s6/ r6 + end structure + + ! Operator overloads to mess with nested member accesses + interface operator (.ne.) + module procedure ne_func + end interface operator (.ne.) + interface operator (.eq.) + module procedure eq_func + end interface operator (.eq.) + interface operator (.test.) + module procedure tstfunc + end interface operator (.test.) + contains + ! ne_func will be called on (x) .ne. (y) + function ne_func (r, i) + integer, intent(in) :: i + type(s1), intent(in) :: r + integer ne_func + ne_func = r%i + i + end function + ! eq_func will be called on (x) .eq. (y) + function eq_func (r, i) + integer, intent(in) :: i + type(s2), intent(in) :: r + integer eq_func + eq_func = r%eq%i + i + end function eq_func + ! tstfunc will be called on (x) .test. (y) + function tstfunc (r, i) + integer, intent(in) :: i + type(s2), intent(in) :: r + integer tstfunc + tstfunc = r%i + i + end function tstfunc +end module + +use dec_structure_10 + +record /s1/ r +record /s2/ struct +record /s7/ r7 +integer i, j +logical l +struct%eq%i = 5 +i = -5 + +! Nested access: struct has a member and which has a member b +l = struct .and. b ! struct%and%b +l = struct .and. b .or. .false. ! (struct%and%b) .or. (.false.) + +! Intrinsic op: r has no member 'ne' +j = r .ne. i ! <intrinsic> ne(r, i) +j = (r) .ne. i ! <intrinsic> ne(r, i) + +! Intrinsic op; r has a member 'ne' but it is not a record +j = r .ne. i ! <intrinsic> ne(r, i) +j = (r) .ne. i ! <intrinsic> ne(r, i) + +! Nested access: struct has a member eq which has a member i +j = struct .eq. i ! struct%eq%i +if ( j .ne. struct%eq%i ) call abort() + +! User op: struct is compared to i with eq_func +j = (struct) .eq. i ! eq_func(struct, i) -> struct%eq%i + i +if ( j .ne. struct%eq%i + i ) call abort() + +! User op: struct has a member test which has a member i, but test is a uop +j = struct .test. i ! tstfunc(struct, i) -> struct%i + i +if ( j .ne. struct%i + i ) call abort() + +! User op: struct is compared to i with eq_func +j = (struct) .test. i ! tstfunc(struct, i) -> struct%i + i +if ( j .ne. struct%i + i ) call abort() + +! Deep nested access tests +r7.r6.r5.r4.r3.r2.i = 1337 +j = r7.r6.r5.r4.r3.r2.i +if ( j .ne. 1337 ) call abort() + +end diff --git a/gcc/testsuite/gfortran.dg/dec_structure_11.f90 b/gcc/testsuite/gfortran.dg/dec_structure_11.f90 new file mode 100644 index 0000000..f6f5b6f --- /dev/null +++ b/gcc/testsuite/gfortran.dg/dec_structure_11.f90 @@ -0,0 +1,20 @@ +! { dg-do compile } +! { dg-options "-fdec-structure" } +! +! Tests for what CAN'T be done with dot ('.') as a member accessor. +! + +structure /s1/ + integer eq +end structure + +record /s1/ r +integer i, j, k + +j = i.j ! { dg-error "nonderived-type variable" } +j = r .eq. i ! { dg-error "Operands of comparison" } +j = r.i ! { dg-error "is not a member of" } +j = r. ! { dg-error "Expected structure component or operator name" } +j = .i ! { dg-error "Invalid character in name" } + +end diff --git a/gcc/testsuite/gfortran.dg/dec_structure_2.f90 b/gcc/testsuite/gfortran.dg/dec_structure_2.f90 new file mode 100644 index 0000000..18db719 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/dec_structure_2.f90 @@ -0,0 +1,41 @@ +! { dg-do run } +! { dg-options "-fdec-structure" } +! +! Test STRUCTUREs containin other STRUCTUREs. +! + +subroutine aborts (s) + character(*), intent(in) :: s + print *, s + call abort() +end subroutine + +! Basic structure +structure /s1/ + integer i1 + logical l1 + real r1 + character c1 +end structure + +structure /s2/ + integer i + record /s1/ r1 +endstructure + +record /s1/ r1 +record /s2/ r2, r2_a(10) + +! Nested and array records +r2.r1.r1 = 135.79 +r2_a(3).r1.i1 = -13579 + +if (r2.r1.r1 .ne. 135.79) then + call aborts("r1.r1.r1") +endif + +if (r2_a(3).r1.i1 .ne. -13579) then + call aborts("r2_a(3).r1.i1") +endif + +end diff --git a/gcc/testsuite/gfortran.dg/dec_structure_3.f90 b/gcc/testsuite/gfortran.dg/dec_structure_3.f90 new file mode 100644 index 0000000..9cb7adb --- /dev/null +++ b/gcc/testsuite/gfortran.dg/dec_structure_3.f90 @@ -0,0 +1,52 @@ +! { dg-do run } +! { dg-options "-fdec-structure" } +! +! Test nested STRUCTURE definitions. +! + +subroutine aborts (s) + character(*), intent(in) :: s + print *, s + call abort() +end subroutine + +structure /s3/ + real p + structure /s4/ recrd, recrd_a(3) + integer i, j + end structure + real q +end structure + +record /s3/ r3 +record /s4/ r4 + +r3.p = 1.3579 +r4.i = 0 +r4.j = 1 +r3.recrd = r4 +r3.recrd_a(1) = r3.recrd +r3.recrd_a(2).i = 1 +r3.recrd_a(2).j = 0 + +if (r3.p .ne. 1.3579) then + call aborts("r3.p") +endif + +if (r4.i .ne. 0) then + call aborts("r4.i") +endif + +if (r4.j .ne. 1) then + call aborts("r4.j") +endif + +if (r3.recrd.i .ne. 0 .or. r3.recrd.j .ne. 1) then + call aborts("r3.recrd") +endif + +if (r3.recrd_a(2).i .ne. 1 .or. r3.recrd_a(2).j .ne. 0) then + call aborts("r3.recrd_a(2)") +endif + +end diff --git a/gcc/testsuite/gfortran.dg/dec_structure_4.f90 b/gcc/testsuite/gfortran.dg/dec_structure_4.f90 new file mode 100644 index 0000000..a941c22 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/dec_structure_4.f90 @@ -0,0 +1,43 @@ +! { dg-do run } +! { dg-options "-fdec-structure" } +! +! Test anonymous STRUCTURE definitions. +! + +subroutine aborts (s) + character(*), intent(in) :: s + print *, s + call abort() +end subroutine + +structure /s5/ + structure recrd, recrd_a(3) + real x, y + end structure +end structure + +record /s5/ r5 + +r5.recrd.x = 1.3 +r5.recrd.y = 5.7 +r5.recrd_a(1) = r5.recrd +r5.recrd_a(2).x = 5.7 +r5.recrd_a(2).y = 1.3 + +if (r5.recrd.x .ne. 1.3) then + call aborts("r5.recrd.x") +endif + +if (r5.recrd.y .ne. 5.7) then + call aborts("r5.recrd.y") +endif + +if (r5.recrd_a(1).x .ne. 1.3 .or. r5.recrd_a(1).y .ne. 5.7) then + call aborts("r5.recrd_a(1)") +endif + +if (r5.recrd_a(2).x .ne. 5.7 .or. r5.recrd_a(2).y .ne. 1.3) then + call aborts("r5.recrd_a(2)") +endif + +end diff --git a/gcc/testsuite/gfortran.dg/dec_structure_5.f90 b/gcc/testsuite/gfortran.dg/dec_structure_5.f90 new file mode 100644 index 0000000..abda3c3 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/dec_structure_5.f90 @@ -0,0 +1,49 @@ +! { dg-do run } +! { dg-options "-fdec-structure" } +! +! Test STRUCTUREs which share names with variables. +! + +subroutine aborts (s) + character(*), intent(in) :: s + print *, s + call abort() +end subroutine + +! Special regression where shared names within a module caused an ICE +! from gfc_get_module_backend_decl +module dec_structure_5m + structure /s6/ + integer i + end structure + + record /s6/ s6 +end module + +program dec_structure_5 + use dec_structure_5m + + structure /s7/ + real r + end structure + + record /s7/ s7(3) + + s6.i = 0 + s7(1).r = 1.0 + s7(2).r = 2.0 + s7(3).r = 3.0 + + if (s6.i .ne. 0) then + call aborts("s6.i") + endif + + if (s7(1).r .ne. 1.0) then + call aborts("s7(1).r") + endif + + if (s7(2).r .ne. 2.0) then + call aborts("s7(2).r") + endif + +end diff --git a/gcc/testsuite/gfortran.dg/dec_structure_6.f90 b/gcc/testsuite/gfortran.dg/dec_structure_6.f90 new file mode 100644 index 0000000..6494d71 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/dec_structure_6.f90 @@ -0,0 +1,46 @@ +! { dg-do run } +! { dg-options "-fdec-structure" } +! +! Test old-style CLIST initializers in STRUCTURE. +! + +subroutine aborts (s) + character(*), intent(in) :: s + print *, s + call abort() +end subroutine + +integer, parameter :: as = 3 +structure /s8/ + character*20 c /"HELLO"/ ! ok + integer*2 j /300_4/ ! ok, converted + integer k /65536_8/ ! ok, implicit + integer*4 l /200000/ ! ok, types match + integer m(5) /5,4,3,2,1/! ok + integer n(5) /1,3*2,1/ ! ok, with repeat spec (/1,2,2,2,1/) + integer o(as) /as*9/ ! ok, parameter array spec + integer p(2,2) /1,2,3,4/! ok + real q(3) /1_2,3.5,2.4E-12_8/ ! ok, with some implicit conversions + integer :: canary = z'3D3D3D3D' +end structure + +record /s8/ r8 + +! Old-style (clist) initializers in structures +if ( r8.c /= "HELLO" ) call aborts ("r8.c") +if ( r8.j /= 300 ) call aborts ("r8.j") +if ( r8.k /= 65536 ) call aborts ("r8.k") +if ( r8.l /= 200000 ) call aborts ("r8.l") +if ( r8.m(1) /= 5 .or. r8.m(2) /= 4 .or. r8.m(3) /= 3 & + .or. r8.m(4) /= 2 .or. r8.m(5) /= 1) & + call aborts ("r8.m") +if ( r8.n(1) /= 1 .or. r8.n(2) /= 2 .or. r8.n(3) /= 2 .or. r8.n(4) /= 2 & + .or. r8.n(5) /= 1) & + call aborts ("r8.n") +if ( r8.o(1) /= 9 .or. r8.o(2) /= 9 .or. r8.o(3) /= 9 ) call aborts ("r8.o") +if ( r8.p(1,1) /= 1 .or. r8.p(2,1) /= 2 .or. r8.p(1,2) /= 3 & + .or. r8.p(2,2) /= 4) & + call aborts ("r8.p") +if ( r8.canary /= z'3D3D3D3D' ) call aborts ("r8.canary") + +end diff --git a/gcc/testsuite/gfortran.dg/dec_structure_7.f90 b/gcc/testsuite/gfortran.dg/dec_structure_7.f90 new file mode 100644 index 0000000..baba1ef --- /dev/null +++ b/gcc/testsuite/gfortran.dg/dec_structure_7.f90 @@ -0,0 +1,75 @@ +! { dg-do run } +! { dg-options "-fdec-structure" } +! +! Test passing STRUCTUREs through functions and subroutines. +! + +subroutine aborts (s) + character(*), intent(in) :: s + print *, s + call abort() +end subroutine + +module dec_structure_7m + structure /s1/ + integer i1 + logical l1 + real r1 + character c1 + end structure + + structure /s2/ + integer i + record /s1/ r1 + endstructure + +contains + ! Pass structure through subroutine + subroutine sub (rec1, i) + implicit none + integer, intent(in) :: i + record /s1/ rec1 + rec1.i1 = i + end subroutine + + ! Pass structure through function + function func (rec2, r) + implicit none + real, intent(in) :: r + record /s2/ rec2 + real func + rec2.r1.r1 = r + func = rec2.r1.r1 + return + end function +end module + +program dec_structure_7 + use dec_structure_7m + + implicit none + record /s1/ r1 + record /s2/ r2 + real junk + + ! Passing through functions and subroutines + r1.i1 = 0 + call sub (r1, 10) + + r2.r1.r1 = 0.0 + junk = func (r2, -20.14) + + if (r1.i1 .ne. 10) then + call aborts("sub(r1, 10)") + endif + + if (r2.r1.r1 .ne. -20.14) then + call aborts("func(r2, -20.14)") + endif + + if (junk .ne. -20.14) then + print *, junk + call aborts("junk = func()") + endif + +end program diff --git a/gcc/testsuite/gfortran.dg/dec_structure_8.f90 b/gcc/testsuite/gfortran.dg/dec_structure_8.f90 new file mode 100644 index 0000000..160b92a --- /dev/null +++ b/gcc/testsuite/gfortran.dg/dec_structure_8.f90 @@ -0,0 +1,60 @@ +! { dg-do compile } +! { dg-options "-fdec-structure -fmax-errors=0" } +! +! Comprehensive compile tests for what structures CAN'T do. +! + +! Old-style (clist) initialization +integer,parameter :: as = 3 +structure /t1/ + integer*1 a /300_2/ ! { dg-error "Arithmetic overflow" } + integer b // ! { dg-error "Empty old style initializer list" } + integer c /2*3/ ! { dg-error "Repeat spec invalid in scalar" } + integer d /1,2,3/ ! { dg-error "End of scalar initializer expected" } + integer e /"HI"/ ! { dg-error "Can't convert" } + integer f(as) /4*9/ ! { dg-error "Too many elements" } + integer g(3) /1,3/ ! { dg-error "Not enough elements" } + integer h(3) /1,3,5,7/ ! { dg-error "Too many elements" } + integer i(3) /2*1/ ! { dg-error "Not enough elements" } + integer j(3) /10*1/ ! { dg-error "Too many elements" } + integer k(3) /2.5*3/ ! { dg-error "Repeat spec must be an integer" } + integer l(2) /2*/ ! { dg-error "Expected data constant" } + integer m(1) / ! { dg-error "Syntax error in old style" } + integer n(2) /1 ! { dg-error "Syntax error in old style" } + integer o(2) /1, ! { dg-error "Syntax error in old style" } + integer p(1) /x/ ! { dg-error "must be a PARAMETER" } +end structure + +structure ! { dg-error "Structure name expected" } +structure / ! { dg-error "Structure name expected" } +structure // ! { dg-error "Structure name expected" } +structure /.or./ ! { dg-error "Structure name expected" } +structure /integer/ ! { dg-error "Structure name.*cannot be the same" } +structure /foo/ bar ! { dg-error "Junk after" } +structure /t1/ ! { dg-error "Type definition.*T1" } + +record ! { dg-error "Structure name expected" } +record bar ! { dg-error "Structure name expected" } +record / bar ! { dg-error "Structure name expected" } +record // bar ! { dg-error "Structure name expected" } +record foo/ bar ! { dg-error "Structure name expected" } +record /foo bar ! { dg-error "Structure name expected" } +record /foo/ bar ! { dg-error "used before it is defined" } +record /t1/ ! { dg-error "Invalid character in name" } + +structure /t2/ + ENTRY here ! { dg-error "ENTRY statement.*cannot appear" } + integer a + integer a ! { dg-error "Component.*already declared" } + structure $z ! { dg-error "Invalid character in name" } + structure // ! { dg-error "Invalid character in name" } + structure // x ! { dg-error "Invalid character in name" } + structure /t3/ ! { dg-error "Invalid character in name" } + structure /t3/ x,$y ! { dg-error "Invalid character in name" } + structure /t4/ y + integer i, j, k + end structure + structure /t4/ z ! { dg-error "Type definition.*T4" } +end structure + +end diff --git a/gcc/testsuite/gfortran.dg/dec_structure_9.f90 b/gcc/testsuite/gfortran.dg/dec_structure_9.f90 new file mode 100644 index 0000000..34c46c6 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/dec_structure_9.f90 @@ -0,0 +1,42 @@ +! { dg-do compile } +! { dg-options "-fdec-structure" } +! +! Basic compile tests for what CAN be done with dot ('.') as a member accessor. +! + +logical :: l, l2 = .true., l3 = .false., and +integer i +character(5) s +real r + +structure /s1/ + integer i + character(5) s + real r +end structure + +record /s1/ r1 + +! Basic +l = l .and. l2 .or. l3 +l = and .and. and .and. and +l = l2 .eqv. l3 +l = (l2) .eqv. l3 + +! Integers +l = .not. (i .eq. 0) +l = .not. (0 .eq. i) +l = .not. (r1.i .eq. 0) +l = .not. (0 .eq. r1.i) +! Characters +l = .not. (s .eq. "hello") +l = .not. ("hello" .eq. s) +l = .not. (r1.s .eq. "hello") +l = .not. ("hello" .eq. r1.s) +! Reals +l = .not. (r .eq. 3.14) +l = .not. (3.14 .eq. r) +l = .not. (r1.r .eq. 3.14) +l = .not. (3.14 .eq. r1.r) + +end diff --git a/gcc/testsuite/gfortran.dg/dec_union_1.f90 b/gcc/testsuite/gfortran.dg/dec_union_1.f90 new file mode 100644 index 0000000..36af53a --- /dev/null +++ b/gcc/testsuite/gfortran.dg/dec_union_1.f90 @@ -0,0 +1,66 @@ +! { dg-do run } +! { dg-options "-fdec-structure" } +! +! Test whether union backend declarations are corrently _not_ copied when they +! are not in fact equal. The structure defined in sub() is seen later, but +! where siz has a different value. +! + +subroutine aborts (s) + character(*), intent(in) :: s + print *, s + call abort() +end subroutine + +subroutine sub () + integer, parameter :: siz = 1024 + structure /s6/ + union ! U0 + map ! M0 + integer ibuf(siz) + end map + map ! M1 + character(8) cbuf(siz) + end map + map ! M2 + real rbuf(siz) + end map + end union + end structure + record /s6/ r6 + r6.ibuf(1) = z'badbeef' + r6.ibuf(2) = z'badbeef' +end subroutine + +! Repeat definition from subroutine sub with different size parameter. +! If the structure definition is copied here the stack may get messed up. +integer, parameter :: siz = 65536 +structure /s6/ + union ! U12 + map + integer ibuf(siz) + end map + map + character(8) cbuf(siz) + end map + map + real rbuf(siz) + end map + end union +end structure + +record /s6/ r6 +integer :: r6_canary = 0 + +! Copied type declaration - this should not cause problems +i = 1 +do while (i < siz) + r6.ibuf(i) = z'badbeef' + i = i + 1 +end do + +if ( r6_canary .ne. 0 ) then + call aborts ('copied decls: overflow') +endif + +end diff --git a/gcc/testsuite/gfortran.dg/dec_union_2.f90 b/gcc/testsuite/gfortran.dg/dec_union_2.f90 new file mode 100644 index 0000000..61e4fd8 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/dec_union_2.f90 @@ -0,0 +1,60 @@ +! { dg-do run } +! { dg-options "-fdec-structure" } +! +! Test basic UNION implementation. +! + +subroutine aborts (s) + character(*), intent(in) :: s + print *, s + call abort() +end subroutine + +! Empty union +structure /s0/ + union ! U0 + map ! M0 + end map + map ! M1 + end map + end union +end structure + +! Basic unions +structure /s1/ + union ! U1 + map ! M2 + integer(4) a + end map + map ! M3 + real(4) b + end map + end union +end structure +structure /s2/ + union ! U2 + map ! M4 + integer(2) w1, w2 + end map + map ! M5 + integer(4) long + end map + end union +end structure + +record /s1/ r1 +record /s2/ r2 + +! Basic unions +r1.a = 0 +r1.b = 1.33e7 +if ( r1.a .eq. 0 ) call aborts ("basic union 1") + +! Endian-agnostic runtime check +r2.long = z'12345678' +if (.not. ( (r2.w1 .eq. z'1234' .and. r2.w2 .eq. z'5678') & + .or. (r2.w1 .eq. z'5678' .and. r2.w2 .eq. z'1234')) ) then + call aborts ("basic union 2") +endif + +end diff --git a/gcc/testsuite/gfortran.dg/dec_union_3.f90 b/gcc/testsuite/gfortran.dg/dec_union_3.f90 new file mode 100644 index 0000000..ce5ae79 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/dec_union_3.f90 @@ -0,0 +1,35 @@ +! { dg-do run } +! { dg-options "-fdec-structure" } +! +! Test UNIONs with initializations. +! + +subroutine aborts (s) + character(*), intent(in) :: s + print *, s + call abort() +end subroutine + +! Initialization expressions +structure /s3/ + integer(4) :: i = 8 + union ! U7 + map + integer(4) :: x = 1600 + integer(4) :: y = 1800 + end map + map + integer(2) a, b, c + end map + end union +end structure + +record /s3/ r3 + +! Initialized unions +if ( r3.x .ne. 1600 .or. r3.y .ne. 1800) then + r3.x = r3.y ! If r3 isn't used the initializations are optimized out + call aborts ("union initialization") +endif + +end diff --git a/gcc/testsuite/gfortran.dg/dec_union_4.f90 b/gcc/testsuite/gfortran.dg/dec_union_4.f90 new file mode 100644 index 0000000..3bf6d61 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/dec_union_4.f90 @@ -0,0 +1,62 @@ +! { dg-do run } +! { dg-options "-fdec-structure" } +! +! Test nested UNIONs. +! + +subroutine aborts (s) + character(*), intent(in) :: s + print *, s + call abort() +end subroutine + +! Nested unions +structure /s4/ + union ! U0 ! rax + map + integer(8) rx + end map + map + integer(4) rh ! rah + union ! U1 + map + integer(4) rl ! ral + end map + map + integer(4) ex ! eax + end map + map + integer(2) eh ! eah + union ! U2 + map + integer(2) el ! eal + end map + map + integer(2) x ! ax + end map + map + integer(1) h ! ah + integer(1) l ! al + end map + end union + end map + end union + end map + end union +end structure +record /s4/ r4 + + +! Nested unions +r4.rx = z'7A7B7CCC7FFFFFFF' +if ( r4.rx .ne. z'7A7B7CCC7FFFFFFF' ) call aborts ("rax") +if ( r4.rh .ne. z'7FFFFFFF' ) call aborts ("rah") +if ( r4.rl .ne. z'7A7B7CCC' ) call aborts ("ral") +if ( r4.ex .ne. z'7A7B7CCC' ) call aborts ("eax") +if ( r4.eh .ne. z'7CCC' ) call aborts ("eah") +if ( r4.el .ne. z'7A7B' ) call aborts ("eal") +if ( r4.x .ne. z'7A7B' ) call aborts ("ax") +if ( r4.h .ne. z'7B' ) call aborts ("ah") +if ( r4.l .ne. z'7A' ) call aborts ("al") + +end diff --git a/gcc/testsuite/gfortran.dg/dec_union_5.f90 b/gcc/testsuite/gfortran.dg/dec_union_5.f90 new file mode 100644 index 0000000..bb1611a --- /dev/null +++ b/gcc/testsuite/gfortran.dg/dec_union_5.f90 @@ -0,0 +1,41 @@ +! { dg-do run } +! { dg-options "-fdec-structure" } +! +! Test UNIONs with array components. +! + +subroutine aborts (s) + character(*), intent(in) :: s + print *, s + call abort() +end subroutine + +! Unions with arrays +structure /s5/ + union + map + character :: s(5) + end map + map + integer(1) :: a(5) + end map + end union +end structure + +record /s5/ r5 + +! Unions with arrays +r5.a(1) = z'41' +r5.a(2) = z'42' +r5.a(3) = z'43' +r5.a(4) = z'44' +r5.a(5) = z'45' +if ( r5.s(1) .ne. 'A' & + .or. r5.s(2) .ne. 'B' & + .or. r5.s(3) .ne. 'C' & + .or. r5.s(4) .ne. 'D' & + .or. r5.s(5) .ne. 'E') then + call aborts ("arrays") +endif + +end diff --git a/gcc/testsuite/gfortran.dg/dec_union_6.f90 b/gcc/testsuite/gfortran.dg/dec_union_6.f90 new file mode 100644 index 0000000..31059c4 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/dec_union_6.f90 @@ -0,0 +1,59 @@ +! { dg-do run } +! { dg-options "-fdec-structure" } +! +! sub0 and sub1 test a regression where calling gfc_use_derived from +! gfc_find_component on the structure type symbol being parsed caused the +! symbol to be freed and swapped for the previously seen type symbol, leaving +! dangling pointers and causing all sorts of mayhem. +! + +subroutine sub0 (u) + structure /s/ + union ! U0 + map ! M0 + integer i + end map + end union + end structure + record /s/ u + u.i = 0 +end subroutine sub0 + +subroutine sub1 () + structure /s/ + union ! U1 + map ! M1 + integer i + end map + end union + end structure + record /s/ u + interface ! matches the declaration of sub0 above + subroutine sub0 (u) + structure /s/ + union ! U2 + map ! M2 + integer i ! gfc_find_component should not call gfc_use_derived + end map ! here, otherwise this structure's type symbol is freed + end union ! out from under it + end structure + record /s/ u + end subroutine sub0 + end interface + call sub0(u) +end subroutine + +! If sub0 and sub1 aren't used they may be omitted +structure /s/ + union ! U1 + map ! M3 + integer i + end map + end union +end structure +record /s/ u + +call sub0(u) +call sub1() + +end diff --git a/gcc/testsuite/gfortran.dg/dec_union_7.f90 b/gcc/testsuite/gfortran.dg/dec_union_7.f90 new file mode 100644 index 0000000..270f0fb --- /dev/null +++ b/gcc/testsuite/gfortran.dg/dec_union_7.f90 @@ -0,0 +1,38 @@ +! { dg-do compile } +! { dg-options "-fdec-structure" } +! +! Comprehensive compile tests for what unions CAN'T do. +! + +! Syntax errors +structure /s0/ + union a b c ! { dg-error "Junk after UNION" } + union + map a b c ! { dg-error "Junk after MAP" } + integer x ! { dg-error "Unexpected" } + structure /s2/ ! { dg-error "Unexpected" } + map + map ! { dg-error "Unexpected" } + end map + end union +end structure + +! Initialization expressions +structure /s1/ + union + map + integer(4) :: x = 1600 ! { dg-error "Conflicting initializers" } + integer(4) :: y = 1800 + end map + map + integer(2) a, b, c, d + integer :: e = 0 ! { dg-error "Conflicting initializers" } + end map + map + real :: p = 1.3, q = 3.7 ! { dg-error "Conflicting initializers" } + end map + end union +end structure +record /s1/ r1 + +end |