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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@100325 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/testsuite/gfortran.dg/char_pointer_assign.f90 b/gcc/testsuite/gfortran.dg/char_pointer_assign.f90
new file mode 100644 (file)
index 0000000..ee3da52
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_pointer_assign.f90
@@ -0,0 +1,41 @@
+! { dg-do run }
+program char_pointer_assign\r
+! Test character pointer assignments, required\r
+! to fix PR18890 and PR21297\r
+! Provided by Paul Thomas pault@gcc.gnu.org\r
+  implicit none\r
+  character*4, target        :: t1\r
+  character*4, target        :: t2(4) =(/"lmno","lmno","lmno","lmno"/)\r
+  character*4                :: const\r
+  character*4, pointer       :: c1, c3\r
+  character*4, pointer       :: c2(:), c4(:)
+  allocate (c3, c4(4))\r
+! Scalars first.\r
+  c3 = "lmno"          ! pointer = constant\r
+  t1 = c3              ! target = pointer\r
+  c1 => t1             ! pointer =>target\r
+  c1(2:3) = "nm"\r
+  c3 = c1              ! pointer = pointer\r
+  c3(1:1) = "o"\r
+  c3(4:4) = "l"\r
+  c1 => c3             ! pointer => pointer\r
+  if (t1 /= "lnmo") call abort ()\r
+  if (c1 /= "onml") call abort ()\r
+\r
+! Now arrays.\r
+  c4 = "lmno"          ! pointer = constant\r
+  t2 = c4              ! target = pointer
+  c2 => t2             ! pointer =>target
+  const = c2(1)
+  const(2:3) ="nm"     ! c2(:)(2:3) = "nm" is still broken\r
+  c2 = const\r
+  c4 = c2              ! pointer = pointer\r
+  const = c4(1)
+  const(1:1) ="o"      ! c4(:)(1:1) = "o" is still broken\r
+  const(4:4) ="l"      ! c4(:)(4:4) = "l" is still broken\r
+  c4 = const\r
+  c2 => c4             ! pointer => pointer\r
+  if (any (t2 /= "lnmo")) call abort ()\r
+  if (any (c2 /= "onml")) call abort ()\r
+  deallocate (c3, c4)\r
+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 (file)
index 0000000..94976cb
--- /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 (file)
index 0000000..1935de5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_pointer_dummy.f90
@@ -0,0 +1,33 @@
+! { dg-do run }
+program char_pointer_dummy\r
+! Test character pointer dummy arguments, required\r
+! to fix PR16939 and PR18689\r
+! Provided by Paul Thomas pault@gcc.gnu.org\r
+  implicit none\r
+  character*4                :: c0\r
+  character*4, pointer       :: c1\r
+  character*4, pointer       :: c2(:)\r
+  allocate (c1, c2(1))\r
+! Check that we have not broken non-pointer characters.\r
+  c0 = "wxyz"\r
+  call foo (c0)\r
+! Now the pointers\r
+  c1 = "wxyz"\r
+  call sfoo (c1)\r
+  c2 = "wxyz"\r
+  call afoo (c2)\r
+  deallocate (c1, c2)\r
+contains\r
+  subroutine foo (cc1)\r
+    character*4                :: cc1\r
+    if (cc1 /= "wxyz") call abort ()\r
+  end subroutine foo\r
+  subroutine sfoo (sc1)\r
+    character*4, pointer       :: sc1\r
+    if (sc1 /= "wxyz") call abort ()\r
+  end subroutine sfoo\r
+  subroutine afoo (ac1)\r
+    character*4, pointer       :: ac1(:)\r
+    if (ac1(1) /= "wxyz") call abort ()\r
+  end subroutine afoo\r
+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 (file)
index 0000000..ddca76f
--- /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