char_initialiser_actual.f90: Test character initialisers as actual arguments.

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

	* gfortran.dg/char_initialiser_actual.f90:
	Test character initialisers as actual arguments.
	* gfortran.dg/char_pointer_comp_assign.f90:
	Test character pointer structure component assignments.
	* gfortran.dg/char_array_structure_constructor.f90:
	Test character components in structure constructors.

From-SVN: r100401

gcc/testsuite/ChangeLog

+2005-05-31  Paul Thomas  <pault@gcc.gnu.org>
+
+	* gfortran.dg/char_initialiser_actual.f90:
+	Test character initialisers as actual arguments.
+	* gfortran.dg/char_pointer_comp_assign.f90:
+	Test character pointer structure component assignments.
+	* gfortran.dg/char_array_structure_constructor.f90:
+	Test character components in structure constructors.
+
 2005-05-31  Andrew pinski  <pinskia@physics.uc.edu>
 
 	PR middle-end/20931

gcc/testsuite/gfortran.dg/char_array_structure_constructor.f90

+! { dg-do run }
+! This test the fix of PR19107, where character array actual
+! arguments in derived type constructors caused an ICE.
+! It also checks that the scalar counterparts are OK.
+! Contributed by Paul Thomas  pault@gcc.gnu.org
+!
+MODULE global
+  TYPE :: dt
+    CHARACTER(4) a
+    CHARACTER(4) b(2)
+  END TYPE
+  TYPE (dt), DIMENSION(:), ALLOCATABLE, SAVE :: c
+END MODULE global
+program char_array_structure_constructor
+  USE global
+  call alloc (2)
+  if ((any (c%a /= "wxyz")) .OR. &
+      (any (c%b(1) /= "abcd")) .OR. &
+      (any (c%b(2) /= "efgh"))) call abort ()
+contains
+  SUBROUTINE alloc (n)
+    USE global
+    ALLOCATE (c(n), STAT=IALLOC_FLAG)
+    DO i = 1,n
+      c (i) = dt ("wxyz",(/"abcd","efgh"/))
+    ENDDO
+  end subroutine alloc
+END program char_array_structure_constructor

gcc/testsuite/gfortran.dg/char_initialiser_actual.f90

+! { dg do-run }
+! Tests passing of character array initialiser as actual argument.
+! Fixes PR18109.
+! Contributed by Paul Thomas pault@gcc.gnu.org  
+program char_initialiser
+  character*5, dimension(3) :: x
+  character*5, dimension(:), pointer :: y
+  x=(/"is Ja","ne Fo","nda"/)
+  call sfoo ("is Ja", x(1))
+  call afoo ((/"is Ja","ne Fo","nda"/), x)
+  y => pfoo ((/"is Ja","ne Fo","nda"/))
+  call afoo (y, x)
+contains
+  subroutine sfoo(ch1, ch2)
+     character*(*)               :: ch1, ch2
+     if (ch1 /= ch2) call abort ()
+  end subroutine sfoo
+  subroutine afoo(ch1, ch2)
+     character*(*), dimension(:) :: ch1, ch2
+     if (any(ch1 /= ch2)) call abort ()
+  end subroutine afoo
+  function pfoo(ch2)
+     character*5, dimension(:), target  :: ch2
+     character*5, dimension(:), pointer :: pfoo
+     pfoo => ch2
+  end function pfoo
+end program

gcc/testsuite/gfortran.dg/char_pointer_comp_assign.f90

+! { dg-do run }
+! This test the fix of PR18283, where assignments of scalar,
+! character pointer components of derived types caused an ICE.
+! It also checks that the array counterparts remain operational.
+! Contributed by Paul Thomas  pault@gcc.gnu.org
+!
+program char_pointer_comp_assign
+  implicit none
+  type :: dt
+     character (len=4), pointer :: scalar
+     character (len=4), pointer :: array(:)
+  end type dt
+  type (dt) :: a 
+  character (len=4), target :: scalar_t ="abcd"
+  character (len=4), target :: array_t(2) = (/"abcd","efgh"/)
+
+! Do assignments first
+  allocate (a%scalar, a%array(2))
+  a%scalar = scalar_t
+  if (a%scalar /= "abcd") call abort ()
+  a%array = array_t
+  if (any(a%array /= (/"abcd","efgh"/))) call abort ()
+  deallocate (a%scalar, a%array)
+
+! Now do pointer assignments.
+  a%scalar => scalar_t
+  if (a%scalar /= "abcd") call abort ()
+  a%array => array_t
+  if (any(a%array /= (/"abcd","efgh"/))) call abort ()
+
+end program char_pointer_comp_assign