From f84d510d21d5c36219041be19f651dad4087939c Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Sun, 29 May 2005 16:03:43 +0000 Subject: [PATCH] char_pointer_assign.f90: Test character-pointerassignments and pointer assignments. 2005-05-29 Paul Thomas * gfortran.dg/char_pointer_assign.f90: Test character-pointerassignments and pointer assignments. * gfortran.dg/char_pointer_dummy.f90: Test character-pointer dummy arguments. * gfortran.dg/char_pointer_func.f90: Test character-pointer function returns. * gfortran.dg/char_pointer_dependency.f90: Test character-pointer functions with dependencies. From-SVN: r100325 --- .../gfortran.dg/char_pointer_assign.f90 | 41 ++++++++++++++++++ .../gfortran.dg/char_pointer_dependency.f90 | 24 +++++++++++ .../gfortran.dg/char_pointer_dummy.f90 | 33 +++++++++++++++ .../gfortran.dg/char_pointer_func.f90 | 42 +++++++++++++++++++ 4 files changed, 140 insertions(+) create mode 100644 gcc/testsuite/gfortran.dg/char_pointer_assign.f90 create mode 100644 gcc/testsuite/gfortran.dg/char_pointer_dependency.f90 create mode 100644 gcc/testsuite/gfortran.dg/char_pointer_dummy.f90 create mode 100644 gcc/testsuite/gfortran.dg/char_pointer_func.f90 diff --git a/gcc/testsuite/gfortran.dg/char_pointer_assign.f90 b/gcc/testsuite/gfortran.dg/char_pointer_assign.f90 new file mode 100644 index 00000000000..ee3da524528 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/char_pointer_assign.f90 @@ -0,0 +1,41 @@ +! { dg-do run } +program char_pointer_assign +! Test character pointer assignments, required +! to fix PR18890 and PR21297 +! Provided by Paul Thomas pault@gcc.gnu.org + implicit none + character*4, target :: t1 + character*4, target :: t2(4) =(/"lmno","lmno","lmno","lmno"/) + character*4 :: const + character*4, pointer :: c1, c3 + character*4, pointer :: c2(:), c4(:) + allocate (c3, c4(4)) +! Scalars first. + c3 = "lmno" ! pointer = constant + t1 = c3 ! target = pointer + c1 => t1 ! pointer =>target + c1(2:3) = "nm" + c3 = c1 ! pointer = pointer + c3(1:1) = "o" + c3(4:4) = "l" + c1 => c3 ! pointer => pointer + if (t1 /= "lnmo") call abort () + if (c1 /= "onml") call abort () + +! Now arrays. + c4 = "lmno" ! pointer = constant + t2 = c4 ! target = pointer + c2 => t2 ! pointer =>target + const = c2(1) + const(2:3) ="nm" ! c2(:)(2:3) = "nm" is still broken + c2 = const + c4 = c2 ! pointer = pointer + const = c4(1) + const(1:1) ="o" ! c4(:)(1:1) = "o" is still broken + const(4:4) ="l" ! c4(:)(4:4) = "l" is still broken + c4 = const + c2 => c4 ! pointer => pointer + if (any (t2 /= "lnmo")) call abort () + if (any (c2 /= "onml")) call abort () + deallocate (c3, c4) +end program char_pointer_assign \ No newline at end of file diff --git a/gcc/testsuite/gfortran.dg/char_pointer_dependency.f90 b/gcc/testsuite/gfortran.dg/char_pointer_dependency.f90 new file mode 100644 index 00000000000..94976cbb33c --- /dev/null +++ b/gcc/testsuite/gfortran.dg/char_pointer_dependency.f90 @@ -0,0 +1,24 @@ +! { dg-do run } +! Test assignments from character pointer functions with dependencies +! are correctly resolved. +! Provided by Paul Thomas pault@gcc.gnu.org +program char_pointer_dependency + implicit none + character*4, pointer :: c2(:) + allocate (c2(2)) + c2 = (/"abcd","efgh"/) + c2 = afoo (c2) + if (c2(1) /= "efgh") call abort () + if (c2(2) /= "abcd") call abort () + deallocate (c2) +contains + function afoo (ac0) result (ac1) + integer :: j + character*4 :: ac0(:) + character*4, pointer :: ac1(:) + allocate (ac1(2)) + do j = 1,2 + ac1(j) = ac0(3-j) + end do + end function afoo +end program char_pointer_dependency diff --git a/gcc/testsuite/gfortran.dg/char_pointer_dummy.f90 b/gcc/testsuite/gfortran.dg/char_pointer_dummy.f90 new file mode 100644 index 00000000000..1935de51113 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/char_pointer_dummy.f90 @@ -0,0 +1,33 @@ +! { dg-do run } +program char_pointer_dummy +! Test character pointer dummy arguments, required +! to fix PR16939 and PR18689 +! Provided by Paul Thomas pault@gcc.gnu.org + implicit none + character*4 :: c0 + character*4, pointer :: c1 + character*4, pointer :: c2(:) + allocate (c1, c2(1)) +! Check that we have not broken non-pointer characters. + c0 = "wxyz" + call foo (c0) +! Now the pointers + c1 = "wxyz" + call sfoo (c1) + c2 = "wxyz" + call afoo (c2) + deallocate (c1, c2) +contains + subroutine foo (cc1) + character*4 :: cc1 + if (cc1 /= "wxyz") call abort () + end subroutine foo + subroutine sfoo (sc1) + character*4, pointer :: sc1 + if (sc1 /= "wxyz") call abort () + end subroutine sfoo + subroutine afoo (ac1) + character*4, pointer :: ac1(:) + if (ac1(1) /= "wxyz") call abort () + end subroutine afoo +end program char_pointer_dummy \ No newline at end of file diff --git a/gcc/testsuite/gfortran.dg/char_pointer_func.f90 b/gcc/testsuite/gfortran.dg/char_pointer_func.f90 new file mode 100644 index 00000000000..ddca76f40b2 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/char_pointer_func.f90 @@ -0,0 +1,42 @@ +! { dg-do run } +program char_pointer_func +! Test assignments from character pointer functions, required +! to fix PR17192 and PR17202 +! Provided by Paul Thomas pault@gcc.gnu.org + implicit none + character*4 :: c0 + character*4, pointer :: c1 + character*4, pointer :: c2(:) + allocate (c1, c2(1)) +! Check that we have not broken non-pointer characters. + c0 = foo () + if (c0 /= "abcd") call abort () +! Value assignments + c1 = sfoo () + if (c1 /= "abcd") call abort () + c2 = afoo (c0) + if (c2(1) /= "abcd") call abort () + deallocate (c1, c2) +! Pointer assignments + c1 => sfoo () + if (c1 /= "abcd") call abort () + c2 => afoo (c0) + if (c2(1) /= "abcd") call abort () + deallocate (c1, c2) +contains + function foo () result (cc1) + character*4 :: cc1 + cc1 = "abcd" + end function foo + function sfoo () result (sc1) + character*4, pointer :: sc1 + allocate (sc1) + sc1 = "abcd" + end function sfoo + function afoo (c0) result (ac1) + character*4 :: c0 + character*4, pointer :: ac1(:) + allocate (ac1(1)) + ac1 = "abcd" + end function afoo +end program char_pointer_func -- 2.30.2