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