summaryrefslogtreecommitdiff
path: root/gcc/testsuite/gfortran.dg/proc_assign_1.f90
blob: e85df7635deb9739f13235bb95559b45a3c636aa (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
! { dg-do compile }
! { dg-options "-std=legacy" }
!
! This tests the patch for PR26787 in which it was found that setting
! the result of one module procedure from within another produced an
! ICE rather than an error.
!
! This is an "elaborated" version of the original testcase from
! Joshua Cogliati  <jjcogliati-r1@yahoo.com>
!
function ext1 ()
    integer ext1, ext2, arg
    ext1 = 1
    entry ext2 (arg)
    ext2 = arg
contains
    subroutine int_1 ()
        ext1 = arg * arg     ! OK - host associated.
    end subroutine int_1
end function ext1

module simple
    implicit none
contains
    integer function foo () 
         foo = 10            ! OK - function result
         call foobar ()
    contains
        subroutine foobar ()
            integer z
            foo = 20         ! OK - host associated.
        end subroutine foobar
    end function foo
    subroutine bar()         ! This was the original bug.
        foo = 10             ! { dg-error "is not a variable" }
    end subroutine bar
    integer function oh_no ()
        oh_no = 1
        foo = 5              ! { dg-error "is not a variable" }
    end function oh_no
end module simple

module simpler
    implicit none
contains
    integer function foo_er () 
         foo_er = 10         ! OK - function result
    end function foo_er
end module simpler

    use simpler
    real w, stmt_fcn
    interface
        function ext1 ()
           integer ext1
        end function ext1
        function ext2 (arg)
           integer ext2, arg
        end function ext2
    end interface
    stmt_fcn (w) = sin (w)     
    call x (y ())
    x = 10                   ! { dg-error "is not a variable" }
    y = 20                   ! { dg-error "is not a variable" }
    foo_er = 8               ! { dg-error "is not a variable" }
    ext1 = 99                ! { dg-error "is not a variable" }
    ext2 = 99                ! { dg-error "is not a variable" }
    stmt_fcn = 1.0           ! { dg-error "is not a variable" }
    w = stmt_fcn (1.0)
contains
    subroutine x (i)
        integer i
        y = i                ! { dg-error "is not a variable" }
    end subroutine x
    function y ()
        integer y
        y = 2                ! OK - function result
    end function y
end
! { dg-final { cleanup-modules "simple simpler" } }