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

Subversion Repositories openrisc

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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 694 jeremybenn
! { dg-do compile }
2
! { dg-options "-std=legacy" }
3
!
4
! This tests the patch for PR26787 in which it was found that setting
5
! the result of one module procedure from within another produced an
6
! ICE rather than an error.
7
!
8
! This is an "elaborated" version of the original testcase from
9
! Joshua Cogliati  
10
!
11
function ext1 ()
12
    integer ext1, ext2, arg
13
    ext1 = 1
14
    entry ext2 (arg)
15
    ext2 = arg
16
contains
17
    subroutine int_1 ()
18
        ext1 = arg * arg     ! OK - host associated.
19
    end subroutine int_1
20
end function ext1
21
 
22
module simple
23
    implicit none
24
contains
25
    integer function foo ()
26
         foo = 10            ! OK - function result
27
         call foobar ()
28
    contains
29
        subroutine foobar ()
30
            integer z
31
            foo = 20         ! OK - host associated.
32
        end subroutine foobar
33
    end function foo
34
    subroutine bar()         ! This was the original bug.
35
        foo = 10             ! { dg-error "is not a variable" }
36
    end subroutine bar
37
    integer function oh_no ()
38
        oh_no = 1
39
        foo = 5              ! { dg-error "is not a variable" }
40
    end function oh_no
41
end module simple
42
 
43
module simpler
44
    implicit none
45
contains
46
    integer function foo_er ()
47
         foo_er = 10         ! OK - function result
48
    end function foo_er
49
end module simpler
50
 
51
    use simpler
52
    real w, stmt_fcn
53
    interface
54
        function ext1 ()
55
           integer ext1
56
        end function ext1
57
        function ext2 (arg)
58
           integer ext2, arg
59
        end function ext2
60
    end interface
61
    stmt_fcn (w) = sin (w)
62
    call x (y ())
63
    x = 10                   ! { dg-error "is not a variable" }
64
    y = 20                   ! { dg-error "is not a variable" }
65
    foo_er = 8               ! { dg-error "is not a variable" }
66
    ext1 = 99                ! { dg-error "is not a variable" }
67
    ext2 = 99                ! { dg-error "is not a variable" }
68
    stmt_fcn = 1.0           ! { dg-error "is not a variable" }
69
    w = stmt_fcn (1.0)
70
contains
71
    subroutine x (i)
72
        integer i
73
        y = i                ! { dg-error "is not a variable" }
74
    end subroutine x
75
    function y ()
76
        integer y
77
        y = 2                ! OK - function result
78
    end function y
79
end
80
! { dg-final { cleanup-modules "simple simpler" } }

powered by: WebSVN 2.1.0

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