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).
