diff options
| author | upstream source tree <ports@midipix.org> | 2015-03-15 20:14:05 -0400 |
|---|---|---|
| committer | upstream source tree <ports@midipix.org> | 2015-03-15 20:14:05 -0400 |
| commit | 554fd8c5195424bdbcabf5de30fdc183aba391bd (patch) | |
| tree | 976dc5ab7fddf506dadce60ae936f43f58787092 /gcc/testsuite/gfortran.dg/proc_assign_1.f90 | |
| download | cbb-gcc-4.6.4-upstream.tar.bz2 cbb-gcc-4.6.4-upstream.tar.xz | |
obtained gcc-4.6.4.tar.bz2 from upstream website;upstream
verified gcc-4.6.4.tar.bz2.sig;
imported gcc-4.6.4 source tree from verified upstream tarball.
downloading a git-generated archive based on the 'upstream' tag
should provide you with a source tree that is binary identical
to the one extracted from the above tarball.
if you have obtained the source via the command 'git clone',
however, do note that line-endings of files in your working
directory might differ from line-endings of the respective
files in the upstream repository.
Diffstat (limited to 'gcc/testsuite/gfortran.dg/proc_assign_1.f90')
| -rw-r--r-- | gcc/testsuite/gfortran.dg/proc_assign_1.f90 | 80 |
1 files changed, 80 insertions, 0 deletions
diff --git a/gcc/testsuite/gfortran.dg/proc_assign_1.f90 b/gcc/testsuite/gfortran.dg/proc_assign_1.f90 new file mode 100644 index 000000000..e85df7635 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/proc_assign_1.f90 @@ -0,0 +1,80 @@ +! { 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
+! { dg-final { cleanup-modules "simple simpler" } }
|