char_pointer_assign.f90: Test character-pointerassignments and pointer assignments.

2005-05-29 Paul Thomas  <pault@gcc.gnu.org>

	* 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

gcc/testsuite/gfortran.dg/char_pointer_assign.f90

+! { 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

gcc/testsuite/gfortran.dg/char_pointer_dependency.f90

+! { 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

gcc/testsuite/gfortran.dg/char_pointer_dummy.f90

+! { 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

gcc/testsuite/gfortran.dg/char_pointer_func.f90

+! { 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