]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
re PR fortran/49397 ([F03] ICE with proc pointer assignment)
authorTobias Burnus <burnus@net-b.de>
Wed, 19 Feb 2014 23:32:46 +0000 (00:32 +0100)
committerTobias Burnus <burnus@gcc.gnu.org>
Wed, 19 Feb 2014 23:32:46 +0000 (00:32 +0100)
2014-02-19  Tobias Burnus  <burnus@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-19  Tobias Burnus  <burnus@net-b.de>

        PR fortran/49397
        * gfortran.dg/proc_ptr_45.f90: New.
        * gfortran.dg/proc_ptr_46.f90: New.

From-SVN: r207927

gcc/fortran/ChangeLog
gcc/fortran/expr.c
gcc/fortran/trans-decl.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/proc_ptr_45.f90 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/proc_ptr_46.f90 [new file with mode: 0644]

index e0e7c24e6683efd0cd70a7e552780c5ab9c8b0ce..6b3fbd6a9065cde3f61672762dce6adcec8fd87e 100644 (file)
@@ -1,3 +1,11 @@
+2014-02-19  Tobias Burnus  <burnus@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-19  Janus Weil  <janus@gcc.gnu.org>
 
        Backports from mainline:
index 7f101ba03d532cf55855a2d35dd8ac243cbe358e..c3dbd01684c0f19ec309416ec245b84c99c7a470 100644 (file)
@@ -3555,6 +3555,16 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue)
          return FAILURE;
        }
 
+      /* 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 FAILURE;
+       }
+
       return SUCCESS;
     }
 
index 7806bbbd8789ed2ce1ebbab6f8b7e73916e5f865..43f918bb2c7ef9859573755059f8532bf6c6f166 100644 (file)
@@ -1358,9 +1358,10 @@ gfc_get_symbol_decl (gfc_symbol * sym)
 
   if (sym->attr.flavor == FL_PROCEDURE)
     {
-      /* Catch function declarations. Only used for actual parameters,
+      /* Catch functions. 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.external || 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);
index ea11c5673b9e44d81f8ba8dd8721e126ca51f2f1..01e697ef962b4caffa894a1fd13ac0a3f94b4fd0 100644 (file)
@@ -1,3 +1,9 @@
+2014-02-19  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/49397
+       * gfortran.dg/proc_ptr_45.f90: New.
+       * gfortran.dg/proc_ptr_46.f90: New.
+
 2014-02-19  Uros Bizjak  <ubizjak@gmail.com>
 
        Backport from mainline
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_45.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_45.f90
new file mode 100644 (file)
index 0000000..a506473
--- /dev/null
@@ -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 (file)
index 0000000..2c05f59
--- /dev/null
@@ -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