re PR fortran/58023 ([F03] ICE on invalid with bad PPC declaration)

2015-01-15  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/58023
	* resolve.c (resolve_fl_derived0): Continue resolving next component
	after error.

2015-01-15  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/58023
	* gfortran.dg/proc_ptr_comp_43.f90: New.

From-SVN: r219676

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index c7080b903434606f6d88c84c8450ff22a489d5d9..df4a2f368400a53987af5a8b4eef91089484571c 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2015-01-15  Janus Weil  <janus@gcc.gnu.org>
+
+       PR fortran/58023
+       * resolve.c (resolve_fl_derived0): Continue resolving next component
+       after error.
+
 2015-01-14  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
        PR fortran/61933

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 6b2444324f7b235f53ac1824cec03a1d727bcbc6..52734e08bb9d85b2391c4a422f7ff53ee9202ce4 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -12377,6 +12377,8 @@ resolve_fl_derived0 (gfc_symbol *sym)
   c = (sym->attr.is_class) ? sym->components->ts.u.derived->components
                           : sym->components;
 
+  bool success = true;
+
   for ( ; c != NULL; c = c->next)
     {
       if (c->attr.artificial)
@@ -12389,7 +12391,8 @@ resolve_fl_derived0 (gfc_symbol *sym)
        {
          gfc_error ("Coarray component %qs at %L must be allocatable with "
                     "deferred shape", c->name, &c->loc);
-         return false;
+         success = false;
+         continue;
        }
 
       /* F2008, C443.  */
@@ -12398,7 +12401,8 @@ resolve_fl_derived0 (gfc_symbol *sym)
        {
          gfc_error ("Component %qs at %L of TYPE(C_PTR) or TYPE(C_FUNPTR) "
                     "shall not be a coarray", c->name, &c->loc);
-         return false;
+         success = false;
+         continue;
        }
 
       /* F2008, C444.  */
@@ -12409,7 +12413,8 @@ resolve_fl_derived0 (gfc_symbol *sym)
          gfc_error ("Component %qs at %L with coarray component "
                     "shall be a nonpointer, nonallocatable scalar",
                     c->name, &c->loc);
-         return false;
+         success = false;
+         continue;
        }
 
       /* F2008, C448.  */
@@ -12417,7 +12422,8 @@ resolve_fl_derived0 (gfc_symbol *sym)
        {
          gfc_error ("Component %qs at %L has the CONTIGUOUS attribute but "
                     "is not an array pointer", c->name, &c->loc);
-         return false;
+         success = false;
+         continue;
        }
 
       if (c->attr.proc_pointer && c->ts.interface)
@@ -12427,7 +12433,8 @@ resolve_fl_derived0 (gfc_symbol *sym)
          if (!sym->attr.vtype && !check_proc_interface (ifc, &c->loc))
            {
              c->tb->error = 1;
-             return false;
+             success = false;
+             continue;
            }
 
          if (ifc->attr.if_source || ifc->attr.intrinsic)
@@ -12471,7 +12478,11 @@ resolve_fl_derived0 (gfc_symbol *sym)
                  gfc_charlen *cl = gfc_new_charlen (sym->ns, ifc->ts.u.cl);
                  if (cl->length && !cl->resolved
                      && !gfc_resolve_expr (cl->length))
-                   return false;
+                   {
+                     c->tb->error = 1;
+                     success = false;
+                     continue;
+                   }
                  c->ts.u.cl = cl;
                }
            }
@@ -12514,7 +12525,8 @@ resolve_fl_derived0 (gfc_symbol *sym)
                             "at %L has no argument %qs", c->name,
                             c->tb->pass_arg, &c->loc, c->tb->pass_arg);
                  c->tb->error = 1;
-                 return false;
+                 success = false;
+                 continue;
                }
            }
          else
@@ -12528,7 +12540,8 @@ resolve_fl_derived0 (gfc_symbol *sym)
                             "must have at least one argument",
                             c->name, &c->loc);
                  c->tb->error = 1;
-                 return false;
+                 success = false;
+                 continue;
                }
              me_arg = c->ts.interface->formal->sym;
            }
@@ -12544,7 +12557,8 @@ resolve_fl_derived0 (gfc_symbol *sym)
                         " the derived type %qs", me_arg->name, c->name,
                         me_arg->name, &c->loc, sym->name);
              c->tb->error = 1;
-             return false;
+             success = false;
+             continue;
            }
 
          /* Check for C453.  */
@@ -12554,7 +12568,8 @@ resolve_fl_derived0 (gfc_symbol *sym)
                         "must be scalar", me_arg->name, c->name, me_arg->name,
                         &c->loc);
              c->tb->error = 1;
-             return false;
+             success = false;
+             continue;
            }
 
          if (me_arg->attr.pointer)
@@ -12563,7 +12578,8 @@ resolve_fl_derived0 (gfc_symbol *sym)
                         "may not have the POINTER attribute", me_arg->name,
                         c->name, me_arg->name, &c->loc);
              c->tb->error = 1;
-             return false;
+             success = false;
+             continue;
            }
 
          if (me_arg->attr.allocatable)
@@ -12572,12 +12588,17 @@ resolve_fl_derived0 (gfc_symbol *sym)
                         "may not be ALLOCATABLE", me_arg->name, c->name,
                         me_arg->name, &c->loc);
              c->tb->error = 1;
-             return false;
+             success = false;
+             continue;
            }
 
          if (gfc_type_is_extensible (sym) && me_arg->ts.type != BT_CLASS)
-           gfc_error ("Non-polymorphic passed-object dummy argument of %qs"
-                      " at %L", c->name, &c->loc);
+           {
+             gfc_error ("Non-polymorphic passed-object dummy argument of %qs"
+                        " at %L", c->name, &c->loc);
+             success = false;
+             continue;
+           }
 
        }
 
@@ -12746,6 +12767,9 @@ resolve_fl_derived0 (gfc_symbol *sym)
        return false;
     }
 
+  if (!success)
+    return false;
+
   check_defined_assignments (sym);
 
   if (!sym->attr.defined_assign_comp && super_type)

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index b54bd8a3dede1857752436f676307c80e3f4d6e8..d5751651b88ee96f9af4ee4d0ed5d9c26e597e0a 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2015-01-15  Janus Weil  <janus@gcc.gnu.org>
+
+       PR fortran/58023
+       * gfortran.dg/proc_ptr_comp_43.f90: New.
+
 2015-01-15  Mike Stump  <mikestump@comcast.net>
 
        * gcc.dg/unroll_1.c: Rename gcc.dg/unroll_[1-5].c to unroll-[2-6].

diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_comp_43.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_comp_43.f90
new file mode 100644 (file)
index 0000000..239fe99
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_comp_43.f90
@@ -0,0 +1,32 @@
+! { dg-do compile }
+!
+! PR 58023: [F03] ICE on invalid with bad PPC declaration
+!
+! Contributed by Andrew Benson <abensonca@gmail.com>
+
+module m
+  implicit none
+
+  abstract interface
+     double precision function mr()
+     end function mr
+  end interface
+
+  type :: sfd
+     procedure(mr), pointer :: mr1  ! { dg-error "must have at least one argument" }
+     procedure(mr), pointer :: mr2  ! { dg-error "must have at least one argument" }
+  end type sfd
+
+contains
+
+  subroutine go()
+    implicit none
+    type(sfd):: d
+
+    write (0,*) d%mr2()
+    return
+  end subroutine go
+
+end module m
+
+! { dg-final { cleanup-modules "m" } }