This patch fixes an ICE on valid error - and a missed diagnostic.
Wording from the standard F2008, Corr2:
C729 (R742) A <procedure-name> shall be the name of a module or dummy
procedure, a specific intrinsic function listed in 13.6 and not marked
with a bullet ($\bullet$), a procedure point, or a specific intrinsic
function listed in 13.6 and not marked with a bullet ($\bullet$), or an
external procedure that is accessed by use or host association,
referenced in the scoping unit as a procedure, or that has the EXTERNAL
attribute.
The ICE is a 4.7/4.8/4.9 regression.
Build and regtested on x86-64-gnu-linux.
OK for the trunk and 4.8? What about 4.7?
Tobias
2014-02-18 Tobias Burnus <bur...@net-b.de>
PR fortran/49397
* expr.c (gfc_check_pointer_assign): Add check for
F2008Cor2, C729.
* trans-decl.c (gfc_get_symbol_decl): Correctly generate external
decl in a corner case.
2014-02-18 Tobias Burnus <bur...@net-b.de>
PR fortran/49397
* gfortran.dg/proc_ptr_45.f90: New.
* gfortran.dg/proc_ptr_46.f90: New.
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 818212a..fe6eab5 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -3581,6 +3581,16 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue)
return false;
}
+ /* Check F2008Cor2, C729. */
+ if (!s2->attr.intrinsic && s2->attr.if_source == IFSRC_UNKNOWN
+ && !s2->attr.external && !s2->attr.subroutine && !s2->attr.function)
+ {
+ gfc_error ("Procedure pointer target '%s' at %L must be either an "
+ "intrinsic, host or use associated, referenced or have "
+ "the EXTERNAL attribute", s2->name, &rvalue->where);
+ return false;
+ }
+
return true;
}
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 9c86653..407e55d 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -1364,7 +1364,8 @@ gfc_get_symbol_decl (gfc_symbol * sym)
{
/* Catch function declarations. Only used for actual parameters,
procedure pointers and procptr initialization targets. */
- if (sym->attr.external || sym->attr.use_assoc || sym->attr.intrinsic)
+ if (sym->attr.use_assoc || sym->attr.intrinsic
+ || sym->attr.if_source != IFSRC_DECL)
{
decl = gfc_get_extern_function_decl (sym);
gfc_set_decl_location (decl, &sym->declared_at);
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_45.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_45.f90
new file mode 100644
index 0000000..a506473
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_45.f90
@@ -0,0 +1,24 @@
+! { dg-do compile }
+!
+! PR fortran/49397
+!
+! Valid per IR F08/0060 and F2008Corr2, C729
+!
+Program m5
+ Print *,f()
+Contains
+ Subroutine s
+ Procedure(Real),Pointer :: p
+ Print *,g()
+ p => f ! (1)
+ Print *,p()
+ p => g ! (2)
+ Print *,p()
+ End Subroutine
+End Program
+Function f()
+ f = 1
+End Function
+Function g()
+ g = 2
+End Function
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_46.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_46.f90
new file mode 100644
index 0000000..2c05f59
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_46.f90
@@ -0,0 +1,14 @@
+! { dg-do compile }
+!
+! PR fortran/49397
+!
+! Invalid per IR F08/0060 and F2008Corr2, C729
+!
+
+! Print *,f() ! << Valid when uncommented
+Contains
+ Subroutine s
+ Procedure(Real),Pointer :: p
+ p => f ! { dg-error "Procedure pointer target 'f' at .1. must be either an intrinsic, host or use associated, referenced or have the EXTERNAL attribute" }
+ End Subroutine
+End
