[Bug fortran/52552] [OOP] ICE when trying to allocate non-allocatable object giving a dynamic type

["janus at gcc dot gnu.org" <gcc-bugzilla@gcc.gnu.org>]

http://gcc.gnu.org/bugzilla/show_bug.cgi?id=52552

janus at gcc dot gnu.org changed:

           What    |Removed                     |Added
----------------------------------------------------------------------------
             Status|NEW                         |ASSIGNED
                 CC|                            |janus at gcc dot gnu.org
         AssignedTo|unassigned at gcc dot       |janus at gcc dot gnu.org
                   |gnu.org                     |

--- Comment #4 from janus at gcc dot gnu.org 2012-06-07 16:25:57 UTC ---
I think one can avoid the whole problem by reshuffling the order of checks
being done in 'gfc_match_allocate', like this:

Index: gcc/fortran/match.c
===================================================================
--- gcc/fortran/match.c    (revision 188139)
+++ gcc/fortran/match.c    (working copy)
@@ -3533,6 +3533,28 @@ gfc_match_allocate (void)
         }
     }

+      /* FIXME: disable the checking on derived types and arrays.  */
+      sym = tail->expr->symtree->n.sym;
+      b1 = !(tail->expr->ref
+       && (tail->expr->ref->type == REF_COMPONENT
+        || tail->expr->ref->type == REF_ARRAY));
+      if (sym && sym->ts.type == BT_CLASS && sym->attr.class_ok)
+    b2 = !(CLASS_DATA (sym)->attr.allocatable
+           || CLASS_DATA (sym)->attr.class_pointer);
+      else
+    b2 = sym && !(sym->attr.allocatable || sym->attr.pointer
+              || sym->attr.proc_pointer);
+      b3 = sym && sym->ns && sym->ns->proc_name
+       && (sym->ns->proc_name->attr.allocatable
+        || sym->ns->proc_name->attr.pointer
+        || sym->ns->proc_name->attr.proc_pointer);
+      if (b1 && b2 && !b3)
+    {
+      gfc_error ("Allocate-object at %L is neither a nonprocedure pointer "
+             "nor an allocatable variable", &tail->expr->where);
+      goto cleanup;
+    }
+
       /* The ALLOCATE statement had an optional typespec.  Check the
      constraints.  */
       if (ts.type != BT_UNKNOWN)
@@ -3558,28 +3580,6 @@ gfc_match_allocate (void)
       if (tail->expr->ts.type == BT_DERIVED)
     tail->expr->ts.u.derived = gfc_use_derived (tail->expr->ts.u.derived);

-      /* FIXME: disable the checking on derived types and arrays.  */
-      sym = tail->expr->symtree->n.sym;
-      b1 = !(tail->expr->ref
-       && (tail->expr->ref->type == REF_COMPONENT
-        || tail->expr->ref->type == REF_ARRAY));
-      if (sym && sym->ts.type == BT_CLASS && sym->attr.class_ok)
-    b2 = !(CLASS_DATA (sym)->attr.allocatable
-           || CLASS_DATA (sym)->attr.class_pointer);
-      else
-    b2 = sym && !(sym->attr.allocatable || sym->attr.pointer
-              || sym->attr.proc_pointer);
-      b3 = sym && sym->ns && sym->ns->proc_name
-       && (sym->ns->proc_name->attr.allocatable
-        || sym->ns->proc_name->attr.pointer
-        || sym->ns->proc_name->attr.proc_pointer);
-      if (b1 && b2 && !b3)
-    {
-      gfc_error ("Allocate-object at %L is neither a nonprocedure pointer "
-             "nor an allocatable variable", &tail->expr->where);
-      goto cleanup;
-    }
-
       if (gfc_peek_ascii_char () == '(' && !sym->attr.dimension)
     {
       gfc_error ("Shape specification for allocatable scalar at %C");


This patch avoids the segfault and correctly rejects the test case. I hope it
does not introduce any other problems (I'll try it on the testsuite soon).