OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [char_result_12.f90] - Blame information for rev 708

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 694 jeremybenn
! { dg-do run }
2
! Tests the fix for PR29912, in which the call to JETTER
3
! would cause a segfault because a temporary was not being written.
4
!
5
! Contributed by Philip Mason  
6
!
7
 program testat
8
 character(len=4)   :: ctemp(2)
9
 character(len=512) :: temper(2)
10
 !
11
 !------------------------
12
 !'This was OK.'
13
 !------------------------
14
 temper(1) = 'doncaster'
15
 temper(2) = 'uxbridge'
16
 ctemp     = temper
17
 if (any (ctemp /= ["donc", "uxbr"])) call abort ()
18
 !
19
 !------------------------
20
 !'This went a bit wrong.'
21
 !------------------------
22
 ctemp = jetter(1,2)
23
 if (any (ctemp /= ["donc", "uxbr"])) call abort ()
24
 
25
 contains
26
   function jetter(id1,id2)
27
   character(len=512) :: jetter(id1:id2)
28
   jetter(id1) = 'doncaster'
29
   jetter(id2) = 'uxbridge'
30
   end function jetter
31
 end program testat

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.