blob: d6a8783919e50f86004102f57d1ab45a52748a40 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
|
! { 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
|
