| ! { 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 |