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

Subversion Repositories openrisc

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

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 PR35959, in which the structure subpattern was declared static
3
! so that this test faied on the second recursive call.
4
!
5
! Contributed by Michaël Baudin 
6
!
7
program testprog
8
  type :: t_type
9
    integer, dimension(:), allocatable :: chars
10
  end type t_type
11
  integer, save :: callnb = 0
12
  type(t_type) :: this
13
  allocate ( this % chars ( 4))
14
  if (.not.recursivefunc (this) .or. (callnb .ne. 10)) call abort ()
15
contains
16
  recursive function recursivefunc ( this ) result ( match )
17
    type(t_type), intent(in) :: this
18
    type(t_type) :: subpattern
19
    logical :: match
20
    callnb = callnb + 1
21
    match = (callnb == 10)
22
    if ((.NOT. allocated (this % chars)) .OR. match) return
23
    allocate ( subpattern % chars ( 4 ) )
24
    match = recursivefunc ( subpattern )
25
  end function recursivefunc
26
end program testprog

powered by: WebSVN 2.1.0

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