mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-03-23 12:10:57 +08:00
Code Issues Packages Projects Releases Wiki Activity

char_initialiser_actual.f90: Test character initialisers as actual arguments.

Browse Source 
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
This commit is contained in:
Paul Thomas 2005-05-31 17:39:03 +00:00
parent 2b052ce2f5
commit fba53b18ab
4 changed files with 95 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,12 @@
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

28
gcc/testsuite/gfortran.dg/char_array_structure_constructor.f90 Executable file
View File

@ -0,0 +1,28 @@
! { 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

27
gcc/testsuite/gfortran.dg/char_initialiser_actual.f90 Executable file
View File

@ -0,0 +1,27 @@
! { 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

31
gcc/testsuite/gfortran.dg/char_pointer_comp_assign.f90 Executable file
View File

@ -0,0 +1,31 @@
! { 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