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