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

Subversion Repositories openrisc

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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 694 jeremybenn
! { dg-do compile }
2
 
3
! PR fortran/37779
4
! Check that a call to a procedure's containing procedure counts as recursive
5
! and is rejected if the containing procedure is not RECURSIVE.
6
 
7
MODULE m
8
  IMPLICIT NONE
9
 
10
CONTAINS
11
 
12
  SUBROUTINE test_sub ()
13
    CALL bar ()
14
  CONTAINS
15
    SUBROUTINE bar ()
16
      IMPLICIT NONE
17
      PROCEDURE(test_sub), POINTER :: procptr
18
 
19
      CALL test_sub () ! { dg-error "not RECURSIVE" }
20
      procptr => test_sub ! { dg-warning "Non-RECURSIVE" }
21
      CALL foobar (test_sub) ! { dg-warning "Non-RECURSIVE" }
22
    END SUBROUTINE bar
23
  END SUBROUTINE test_sub
24
 
25
  INTEGER FUNCTION test_func () RESULT (x)
26
    x = bar ()
27
  CONTAINS
28
    INTEGER FUNCTION bar ()
29
      IMPLICIT NONE
30
      PROCEDURE(test_func), POINTER :: procptr
31
 
32
      bar = test_func () ! { dg-error "not RECURSIVE" }
33
      procptr => test_func ! { dg-warning "Non-RECURSIVE" }
34
      CALL foobar (test_func) ! { dg-warning "Non-RECURSIVE" }
35
    END FUNCTION bar
36
  END FUNCTION test_func
37
 
38
  SUBROUTINE sub_entries ()
39
  ENTRY sub_entry_1 ()
40
  ENTRY sub_entry_2 ()
41
    CALL bar ()
42
  CONTAINS
43
    SUBROUTINE bar ()
44
      CALL sub_entry_1 () ! { dg-error "is not RECURSIVE" }
45
    END SUBROUTINE bar
46
  END SUBROUTINE sub_entries
47
 
48
  INTEGER FUNCTION func_entries () RESULT (x)
49
  ENTRY func_entry_1 () RESULT (x)
50
  ENTRY func_entry_2 () RESULT (x)
51
    x = bar ()
52
  CONTAINS
53
    INTEGER FUNCTION bar ()
54
      bar = func_entry_1 () ! { dg-error "is not RECURSIVE" }
55
    END FUNCTION bar
56
  END FUNCTION func_entries
57
 
58
  SUBROUTINE main ()
59
    CALL test_sub ()
60
    CALL sub_entries ()
61
    PRINT *, test_func (), func_entries ()
62
  END SUBROUTINE main
63
 
64
END MODULE m
65
 
66
! { dg-final { cleanup-modules "m" } }

powered by: WebSVN 2.1.0

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