From df3927406e3ca1ed7620332a8608ad4bce4c45c6 Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Sat, 8 Feb 2014 16:22:46 +0000 Subject: [PATCH] re PR fortran/60066 (Bad elemental invocation of non-scalar base object) 2014-02-08 Paul Thomas PR fortran/60066 * gfortran.dg/elemental_subroutine_10.f90 : New test. This PR was fixed by the patch for PR59906. From-SVN: r207633 --- gcc/testsuite/ChangeLog | 6 ++ .../gfortran.dg/elemental_subroutine_10.f90 | 68 ++++++++++++++++++++++ 2 files changed, 74 insertions(+) create mode 100644 gcc/testsuite/gfortran.dg/elemental_subroutine_10.f90 diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 867834b..8448c42 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2014-02-08 Paul Thomas + + PR fortran/60066 + * gfortran.dg/elemental_subroutine_10.f90 : New test. This PR + was fixed by the patch for PR59906. + 2014-02-08 Andreas Schwab PR translation/52289 diff --git a/gcc/testsuite/gfortran.dg/elemental_subroutine_10.f90 b/gcc/testsuite/gfortran.dg/elemental_subroutine_10.f90 new file mode 100644 index 0000000..be343e6 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/elemental_subroutine_10.f90 @@ -0,0 +1,68 @@ +! { dg-do run } +! +! PR fortran/60066 +! +! Contributed by F Martinez Fadrique +! +! Fixed by the patch for PR59906 but adds another, different test. +! +module m_assertion_character + implicit none + type :: t_assertion_character + character(len=8) :: name + contains + procedure :: assertion_character + procedure :: write => assertion_array_write + end type t_assertion_character +contains + elemental subroutine assertion_character( ast, name ) + class(t_assertion_character), intent(out) :: ast + character(len=*), intent(in) :: name + ast%name = name + end subroutine assertion_character + subroutine assertion_array_write( ast, unit ) + class(t_assertion_character), intent(in) :: ast + character(*), intent(inOUT) :: unit + write(unit,*) trim (unit(2:len(unit)))//trim (ast%name) + end subroutine assertion_array_write +end module m_assertion_character + +module m_assertion_array_character + use m_assertion_character + implicit none + type :: t_assertion_array_character + type(t_assertion_character), dimension(:), allocatable :: rast + contains + procedure :: assertion_array_character + procedure :: write => assertion_array_character_write + end type t_assertion_array_character +contains + pure subroutine assertion_array_character( ast, name, nast ) + class(t_assertion_array_character), intent(out) :: ast + character(len=*), intent(in) :: name + integer, intent(in) :: nast + integer :: i + allocate ( ast%rast(nast) ) + call ast%rast%assertion_character ( name ) + end subroutine assertion_array_character + subroutine assertion_array_character_write( ast, unit ) + class(t_assertion_array_character), intent(in) :: ast + CHARACTER(*), intent(inOUT) :: unit + integer :: i + do i = 1, size (ast%rast) + call ast%rast(i)%write (unit) + end do + end subroutine assertion_array_character_write +end module m_assertion_array_character + +program main + use m_assertion_array_character + implicit none + type(t_assertion_array_character) :: ast + character(len=8) :: name + character (26) :: line = '' + name = 'test' + call ast%assertion_array_character ( name, 5 ) + call ast%write (line) + if (line(2:len (line)) .ne. "testtesttesttesttest") call abort +end program main -- 2.7.4