Dear All,

I propose to add the attached to the testsuite.  It is the testcase
from PR60066, which was fixed by the patch for PR59066.

OK for trunk, 4.8 and 4.7?

On 5 February 2014 12:38, pault at gcc dot gnu.org
<gcc-bugzi...@gcc.gnu.org> wrote:
> http://gcc.gnu.org/bugzilla/show_bug.cgi?id=60066
>
> Paul Thomas <pault at gcc dot gnu.org> changed:
>
>            What    |Removed                     |Added
> ----------------------------------------------------------------------------
>          Resolution|DUPLICATE                   |FIXED
>
> --- Comment #8 from Paul Thomas <pault at gcc dot gnu.org> ---
> (In reply to Dominique d'Humieres from comment #5)
>> > I have applied the patch at 
>> > http://gcc.gnu.org/ml/fortran/2014-02/txtX3eVILZEGw.txt
>> > on top of 4.8.3 r206497 and the test runs successfully ...
>>
>> Marking as duplicate of pr49906.
>>
>> Paul,
>>
>> For the record, no regression when testing with
>>
>> make -k -j8 check-gfortran RUNTESTFLAGS="--target_board=unix'{-m32,-m64}'"
>>
>> *** This bug has been marked as a duplicate of bug 49906 ***
>
> I will, however, add this testcase to that of PR59906 - it is different yet
> again from the verification tests although it is fixed by the patch.
>
> Cheers
>
> Pau
>
> --
> You are receiving this mail because:
> You are on the CC list for the bug.



-- 
The knack of flying is learning how to throw yourself at the ground and miss.
       --Hitchhikers Guide to the Galaxy
Index: gcc/testsuite/gfortran.dg/elemental_subroutine_10.f90
===================================================================
*** gcc/testsuite/gfortran.dg/elemental_subroutine_10.f90       (revision 0)
--- gcc/testsuite/gfortran.dg/elemental_subroutine_10.f90       (working copy)
***************
*** 0 ****
--- 1,68 ----
+ ! { dg-do run }
+ !
+ ! PR fortran/60066
+ !
+ ! Contributed by F Martinez Fadrique  <fmarti...@gmv.com>
+ !
+ ! 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

Reply via email to