1! { 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  <jjcogliati-r1@yahoo.com>
10!
11function ext1 ()
12    integer ext1, ext2, arg
13    ext1 = 1
14    entry ext2 (arg)
15    ext2 = arg
16contains
17    subroutine int_1 ()
18        ext1 = arg * arg     ! OK - host associated.
19    end subroutine int_1
20end function ext1
21
22module simple
23    implicit none
24contains
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
41end module simple
42
43module simpler
44    implicit none
45contains
46    integer function foo_er ()
47         foo_er = 10         ! OK - function result
48    end function foo_er
49end 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)
70contains
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
79end
80