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

Subversion Repositories openrisc

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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 694 jeremybenn
! { dg-do run }
2
! Tests the fix for PR19546 in which an ICE would result from
3
! setting the parent result in a contained procedure.
4
! This case tests character results.
5
!
6
function f()
7
  character(4) :: f
8
  f = "efgh"
9
  call sub ()
10
  if (f.eq."iklm") f = "abcd"
11
  call sub ()
12
contains
13
  subroutine sub
14
    f = "wxyz"
15
    if (f.eq."efgh") f = "iklm"
16
  end subroutine sub
17
end function f
18
 
19
function g()              ! { dg-warning "Obsolescent feature" }
20
  character(*) :: g
21
  g = "efgh"
22
  call sub ()
23
  if (g.eq."iklm") g = "ABCD"
24
  call sub ()
25
contains
26
  subroutine sub
27
    g = "WXYZ"
28
    if (g.eq."efgh") g = "iklm"
29
  end subroutine sub
30
end function g
31
 
32
  character(4), external :: f, g
33
  if (f ().ne."wxyz") call abort ()
34
  if (g ().ne."WXYZ") call abort ()
35
end

powered by: WebSVN 2.1.0

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