! { dg-do compile }
|
! { dg-do compile }
|
! This tests the patch for PR26787 in which it was found that setting
|
! This tests the patch for PR26787 in which it was found that setting
|
! the result of one module procedure from within another produced an
|
! the result of one module procedure from within another produced an
|
! ICE rather than an error.
|
! ICE rather than an error.
|
!
|
!
|
! This is an "elaborated" version of the original testcase from
|
! This is an "elaborated" version of the original testcase from
|
! Joshua Cogliati
|
! Joshua Cogliati
|
!
|
!
|
function ext1 ()
|
function ext1 ()
|
integer ext1, ext2, arg
|
integer ext1, ext2, arg
|
ext1 = 1
|
ext1 = 1
|
entry ext2 (arg)
|
entry ext2 (arg)
|
ext2 = arg
|
ext2 = arg
|
contains
|
contains
|
subroutine int_1 ()
|
subroutine int_1 ()
|
ext1 = arg * arg ! OK - host associated.
|
ext1 = arg * arg ! OK - host associated.
|
end subroutine int_1
|
end subroutine int_1
|
end function ext1
|
end function ext1
|
|
|
module simple
|
module simple
|
implicit none
|
implicit none
|
contains
|
contains
|
integer function foo ()
|
integer function foo ()
|
foo = 10 ! OK - function result
|
foo = 10 ! OK - function result
|
call foobar ()
|
call foobar ()
|
contains
|
contains
|
subroutine foobar ()
|
subroutine foobar ()
|
integer z
|
integer z
|
foo = 20 ! OK - host associated.
|
foo = 20 ! OK - host associated.
|
end subroutine foobar
|
end subroutine foobar
|
end function foo
|
end function foo
|
subroutine bar() ! This was the original bug.
|
subroutine bar() ! This was the original bug.
|
foo = 10 ! { dg-error "is not a VALUE" }
|
foo = 10 ! { dg-error "is not a VALUE" }
|
end subroutine bar
|
end subroutine bar
|
integer function oh_no ()
|
integer function oh_no ()
|
oh_no = 1
|
oh_no = 1
|
foo = 5 ! { dg-error "is not a VALUE" }
|
foo = 5 ! { dg-error "is not a VALUE" }
|
end function oh_no
|
end function oh_no
|
end module simple
|
end module simple
|
|
|
module simpler
|
module simpler
|
implicit none
|
implicit none
|
contains
|
contains
|
integer function foo_er ()
|
integer function foo_er ()
|
foo_er = 10 ! OK - function result
|
foo_er = 10 ! OK - function result
|
end function foo_er
|
end function foo_er
|
end module simpler
|
end module simpler
|
|
|
use simpler
|
use simpler
|
real w, stmt_fcn
|
real w, stmt_fcn
|
interface
|
interface
|
function ext1 ()
|
function ext1 ()
|
integer ext1
|
integer ext1
|
end function ext1
|
end function ext1
|
function ext2 (arg)
|
function ext2 (arg)
|
integer ext2, arg
|
integer ext2, arg
|
end function ext2
|
end function ext2
|
end interface
|
end interface
|
stmt_fcn (w) = sin (w)
|
stmt_fcn (w) = sin (w)
|
call x (y ())
|
call x (y ())
|
x = 10 ! { dg-error "Expected VARIABLE" }
|
x = 10 ! { dg-error "Expected VARIABLE" }
|
y = 20 ! { dg-error "is not a VALUE" }
|
y = 20 ! { dg-error "is not a VALUE" }
|
foo_er = 8 ! { dg-error "is not a VALUE" }
|
foo_er = 8 ! { dg-error "is not a VALUE" }
|
ext1 = 99 ! { dg-error "is not a VALUE" }
|
ext1 = 99 ! { dg-error "is not a VALUE" }
|
ext2 = 99 ! { dg-error "is not a VALUE" }
|
ext2 = 99 ! { dg-error "is not a VALUE" }
|
stmt_fcn = 1.0 ! { dg-error "Expected VARIABLE" }
|
stmt_fcn = 1.0 ! { dg-error "Expected VARIABLE" }
|
w = stmt_fcn (1.0)
|
w = stmt_fcn (1.0)
|
contains
|
contains
|
subroutine x (i)
|
subroutine x (i)
|
integer i
|
integer i
|
y = i ! { dg-error "is not a VALUE" }
|
y = i ! { dg-error "is not a VALUE" }
|
end subroutine x
|
end subroutine x
|
function y ()
|
function y ()
|
integer y
|
integer y
|
y = 2 ! OK - function result
|
y = 2 ! OK - function result
|
end function y
|
end function y
|
end
|
end
|
! { dg-final { cleanup-modules "simple simpler" } }
|
! { dg-final { cleanup-modules "simple simpler" } }
|
|
|
