[Bug fortran/23308] named common block confused as procedure - runtime segfault

[paulthomas2 at wanadoo dot fr]

------- Comment #6 from paulthomas2 at wanadoo dot fr  2006-01-07 21:44 -------
Subject: Re:  named common block confused as procedure
 - runtime segfault

Steve and Andrew,

>------- Comment #5 from kargl at gcc dot gnu dot org  2006-01-07 20:19 -------
>Andrew, Lahey's code checking utility gives
>
>Compiling program unit f at line 1:
>Compiling program unit test at line 5:
>Encountered 0 errors, 0 warnings, 0 informations in file SOURCE.F90.
>Compiling file SOURCE.F90.
>
>NAG's compiler also compiles the code without an error or warning.
>
>
>  
>
The enclosed patch catches Andrew's PR but also snags on 
g77/19990905-1.f (The Burley test case).  I will sit down with the 
standard and sort out what is and is not required of global symbols, 
contained symbols and scopes in general.  If nothing else, the enclosed 
will catch some nasties that are escaping at the moment.

Best regards

Paul
Index: gcc/fortran/resolve.c
===================================================================
*** gcc/fortran/resolve.c       (revision 109449)
--- gcc/fortran/resolve.c       (working copy)
*************** resolve_function (gfc_expr * expr)
*** 1157,1162 ****
--- 1157,1172 ----
    try t;
    int temp;

+   gfc_gsymbol * gsym;
+ 
+   gsym = NULL;
+   if (expr->symtree && expr->symtree->n.sym)
+     gsym = gfc_find_gsymbol (gfc_gsym_root, expr->symtree->n.sym->name);
+ 
+   if ((gsym && gsym->type != GSYM_UNKNOWN && gsym->type != GSYM_FUNCTION))
+     gfc_warning_now ("reference at %L to %s which is not a function",
+                    &expr->where, expr->symtree->n.sym->name);
+ 
    /* Switch off assumed size checking and do this again for certain kinds
       of procedure, once the procedure itself is resolved.  */
    need_full_assumed_size++;
*************** resolve_call (gfc_code * c)
*** 1510,1515 ****
--- 1520,1535 ----
  {
    try t;

+   gfc_gsymbol * gsym;
+ 
+   gsym = NULL;
+   if (c->symtree && c->symtree->n.sym)
+     gsym = gfc_find_gsymbol (gfc_gsym_root, c->symtree->n.sym->name);
+ 
+   if ((gsym && gsym->type != GSYM_UNKNOWN && gsym->type != GSYM_SUBROUTINE))
+     gfc_warning_now ("CALL at %L to %s which is not a subroutine",
+                    &c->loc, c->symtree->n.sym->name);
+ 
    /* Switch off assumed size checking and do this again for certain kinds
       of procedure, once the procedure itself is resolved.  */
    need_full_assumed_size++;
Index: gcc/fortran/match.c
===================================================================
*** gcc/fortran/match.c (revision 109448)
--- gcc/fortran/match.c (working copy)
*************** gfc_match_common (void)
*** 2247,2252 ****
--- 2247,2253 ----
    gfc_array_spec *as;
    gfc_equiv * e1, * e2;
    match m;
+   gfc_gsymbol *gsym;

    old_blank_common = gfc_current_ns->blank_common.head;
    if (old_blank_common)
*************** gfc_match_common (void)
*** 2263,2268 ****
--- 2264,2278 ----
        if (m == MATCH_ERROR)
        goto cleanup;

+       gsym = gfc_get_gsymbol (name);
+       if (gsym->type != GSYM_UNKNOWN && gsym->type != GSYM_COMMON)
+       {
+         gfc_error ("Symbol '%s' at %C is already an external symbol that is
not COMMON",
+                    sym->name);
+         goto cleanup;
+       }
+       gsym->type = GSYM_COMMON;
+ 
        if (name[0] == '\0')
        {
          t = &gfc_current_ns->blank_common;


-- 


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