Hi all,
the attached patch implements some missing constraints from Fortran
2008 concerning procedure pointer initialization (cf. the standard
quote in comment #18), thus fixing two accepts-invalid and
ICE-on-invalid problems.
It regtests cleanly on x86_64-linux-gnu. Ok for trunk?
Cheers,
Janus
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index e1fdb93f3d0..372c517487f 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2019-03-27 Janus Weil <ja...@gcc.gnu.org>
+
+ PR fortran/85537
+ * expr.c (gfc_check_assign_symbol): Reject internal and dummy procedures
+ in procedure pointer initialization.
+
2019-03-27 Paul Thomas <pa...@gcc.gnu.org>
PR fortran/88247
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index f54affae18d..478a5557723 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -4407,6 +4407,20 @@ gfc_check_assign_symbol (gfc_symbol *sym, gfc_component *comp, gfc_expr *rvalue)
"may not be a procedure pointer", &rvalue->where);
return false;
}
+ if (attr.proc == PROC_INTERNAL)
+ {
+ gfc_error ("Internal procedure %qs is invalid in "
+ "procedure pointer initialization at %L",
+ rvalue->symtree->name, &rvalue->where);
+ return false;
+ }
+ if (attr.dummy)
+ {
+ gfc_error ("Dummy procedure %qs is invalid in "
+ "procedure pointer initialization at %L",
+ rvalue->symtree->name, &rvalue->where);
+ return false;
+ }
}
return true;
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 0679cb72e52..f6df0b1281c 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2019-03-27 Janus Weil <ja...@gcc.gnu.org>
+
+ PR fortran/85537
+ * gfortran.dg/dummy_procedure_11.f90: Fix test case.
+ * gfortran.dg/pointer_init_11.f90: New test case.
+
2019-03-27 Richard Biener <rguent...@suse.de>
* gcc.dg/torture/20190327-1.c: New testcase.
diff --git a/gcc/testsuite/gfortran.dg/dummy_procedure_11.f90 b/gcc/testsuite/gfortran.dg/dummy_procedure_11.f90
index f51c5455c05..3e4b2b1d6f0 100644
--- a/gcc/testsuite/gfortran.dg/dummy_procedure_11.f90
+++ b/gcc/testsuite/gfortran.dg/dummy_procedure_11.f90
@@ -5,16 +5,18 @@
! Contributed by Vladimir Fuka <vladimir.f...@gmail.com>
type :: t
- procedure(g), pointer, nopass :: ppc => g
+ procedure(g), pointer, nopass :: ppc
end type
-procedure(g), pointer :: pp => g
+procedure(g), pointer :: pp
type(t)::x
print *, f(g)
print *, f(g()) ! { dg-error "Expected a procedure for argument" }
+pp => g
print *, f(pp)
print *, f(pp()) ! { dg-error "Expected a procedure for argument" }
+x%ppc => g
print *, f(x%ppc)
print *, f(x%ppc()) ! { dg-error "Expected a procedure for argument" }
diff --git a/gcc/testsuite/gfortran.dg/pointer_init_11.f90 b/gcc/testsuite/gfortran.dg/pointer_init_11.f90
new file mode 100644
index 00000000000..3113e157687
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pointer_init_11.f90
@@ -0,0 +1,44 @@
+! { dg-do compile }
+!
+! PR 85537: [F08] Invalid memory reference at runtime when calling subroutine through procedure pointer
+!
+! Contributed by Tiziano Müller <dev-z...@gentoo.org>
+
+module m1
+ implicit none
+contains
+ subroutine foo()
+ integer :: a
+
+ abstract interface
+ subroutine ibar()
+ end subroutine
+ end interface
+
+ procedure(ibar), pointer :: bar_ptr => bar_impl ! { dg-error "invalid in procedure pointer initialization" }
+
+ contains
+ subroutine bar_impl()
+ write (*,*) "foo"
+ a = a + 1
+ end subroutine
+
+ end subroutine
+end module
+
+
+module m2
+ implicit none
+contains
+ subroutine foo(dbar)
+ interface
+ subroutine dbar()
+ end subroutine
+ end interface
+
+ procedure(dbar), pointer :: bar_ptr => dbar ! { dg-error "invalid in procedure pointer initialization" }
+
+ call bar_ptr()
+
+ end subroutine
+end module
