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

4 files changed, 140 insertions, 0 deletions

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 0000000..ee3da52
--- /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 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
index 0000000..1935de51
--- /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 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