aboutsummaryrefslogtreecommitdiff
path: root/gcc/fortran/resolve.c
diff options
context:
space:
mode:
authorPaul Thomas <pault@gcc.gnu.org>2006-01-21 09:08:54 +0000
committerPaul Thomas <pault@gcc.gnu.org>2006-01-21 09:08:54 +0000
commit68ea355b5d9b51b994e0780d8392f7542262072f (patch)
treed96186ed49727fa545b68d7e5eaffe6789ccb236 /gcc/fortran/resolve.c
parent4e27a177f8a488fc1f9a3462672582715e164f0d (diff)
downloadgcc-68ea355b5d9b51b994e0780d8392f7542262072f.zip
gcc-68ea355b5d9b51b994e0780d8392f7542262072f.tar.gz
gcc-68ea355b5d9b51b994e0780d8392f7542262072f.tar.bz2
PR25024, PR20881, PR23308, PR25538 and PR25710 - Procedure references
2005-01-21 Paul Thomas <pault@gcc.gnu.org> PR fortran/25124 PR fortran/25625 * decl.c (get_proc_name): If there is an existing symbol in the encompassing namespace, call errors if it is a procedure of the same name or the kind field is set, indicating a type declaration. PR fortran/20881 PR fortran/23308 PR fortran/25538 PR fortran/25710 * decl.c (add_global_entry): New function to check for existing global symbol with this name and to create new one if none exists. (gfc_match_entry): Call add_global_entry before matching argument lists for subroutine and function entries. * gfortran.h: Prototype for existing function, global_used. * resolve.c (resolve_global_procedure): New function to check global symbols for procedures. (resolve_call, resolve_function): Calls to this new function for non-contained and non-module procedures. * match.c (match_common): Add check for existing global symbol, creat one if none exists and emit error if there is a clash. * parse.c (global_used): Remove static and use the gsymbol name rather than the new_block name, so that the function can be called from resolve.c. (parse_block_data, parse_module, add_global_procedure): Improve checks for existing gsymbols. Emit error if already defined or if references were to another type. Set defined flag. PR fortran/PR24276 * trans-expr.c (gfc_conv_aliased_arg): New function called by gfc_conv_function_call that coverts an expression for an aliased component reference to a derived type array into a temporary array of the same type as the component. The temporary is passed as an actual argument for the procedure call and is copied back to the derived type after the call. (is_aliased_array): New function that detects an array reference that is followed by a component reference. (gfc_conv_function_call): Detect an aliased actual argument with is_aliased_array and convert it to a temporary and back again using gfc_conv_aliased_arg. 2005-01-21 Paul Thomas <pault@gcc.gnu.org> PR fortran/25124 PR fortran/25625 * gfortran.dg/internal_references_1.f90: New test. PR fortran/20881 PR fortran/23308 PR fortran/25538 PR fortran/25710 * gfortran.dg/global_references_1.f90: New test. * gfortran.dg/g77/19990905-1.f: Restore the error that there is a clash between the common block name and the name of a subroutine reference. PR fortran/PR24276 * gfortran.dg/aliasing_dummy_1.f90: New test. From-SVN: r110063
Diffstat (limited to 'gcc/fortran/resolve.c')
-rw-r--r--gcc/fortran/resolve.c66
1 files changed, 58 insertions, 8 deletions
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index af95316..1d8a71b 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -885,6 +885,36 @@ find_noncopying_intrinsics (gfc_symbol * fnsym, gfc_actual_arglist * actual)
ap->expr->inline_noncopying_intrinsic = 1;
}
+/* This function does the checking of references to global procedures
+ as defined in sections 18.1 and 14.1, respectively, of the Fortran
+ 77 and 95 standards. It checks for a gsymbol for the name, making
+ one if it does not already exist. If it already exists, then the
+ reference being resolved must correspond to the type of gsymbol.
+ Otherwise, the new symbol is equipped with the attributes of the
+ reference. The corresponding code that is called in creating
+ global entities is parse.c. */
+
+static void
+resolve_global_procedure (gfc_symbol *sym, locus *where, int sub)
+{
+ gfc_gsymbol * gsym;
+ uint type;
+
+ type = sub ? GSYM_SUBROUTINE : GSYM_FUNCTION;
+
+ gsym = gfc_get_gsymbol (sym->name);
+
+ if ((gsym->type != GSYM_UNKNOWN && gsym->type != type))
+ global_used (gsym, where);
+
+ if (gsym->type == GSYM_UNKNOWN)
+ {
+ gsym->type = type;
+ gsym->where = *where;
+ }
+
+ gsym->used = 1;
+}
/************* Function resolution *************/
@@ -1157,6 +1187,14 @@ resolve_function (gfc_expr * expr)
try t;
int temp;
+ /* If the procedure is not internal or module, it must be external and
+ should be checked for usage. */
+ if (expr->symtree && expr->symtree->n.sym
+ && !expr->symtree->n.sym->attr.dummy
+ && !expr->symtree->n.sym->attr.contained
+ && !expr->symtree->n.sym->attr.use_assoc)
+ resolve_global_procedure (expr->symtree->n.sym, &expr->where, 0);
+
/* Switch off assumed size checking and do this again for certain kinds
of procedure, once the procedure itself is resolved. */
need_full_assumed_size++;
@@ -1511,6 +1549,14 @@ resolve_call (gfc_code * c)
{
try t;
+ /* If the procedure is not internal or module, it must be external and
+ should be checked for usage. */
+ if (c->symtree && c->symtree->n.sym
+ && !c->symtree->n.sym->attr.dummy
+ && !c->symtree->n.sym->attr.contained
+ && !c->symtree->n.sym->attr.use_assoc)
+ resolve_global_procedure (c->symtree->n.sym, &c->loc, 1);
+
/* Switch off assumed size checking and do this again for certain kinds
of procedure, once the procedure itself is resolved. */
need_full_assumed_size++;
@@ -4805,6 +4851,18 @@ resolve_symbol (gfc_symbol * sym)
}
break;
+ case FL_PROCEDURE:
+ /* An external symbol may not have an intializer because it is taken to be
+ a procedure. */
+ if (sym->attr.external && sym->value)
+ {
+ gfc_error ("External object '%s' at %L may not have an initializer",
+ sym->name, &sym->declared_at);
+ return;
+ }
+
+ break;
+
case FL_DERIVED:
/* Add derived type to the derived type list. */
{
@@ -4818,14 +4876,6 @@ resolve_symbol (gfc_symbol * sym)
default:
- /* An external symbol falls through to here if it is not referenced. */
- if (sym->attr.external && sym->value)
- {
- gfc_error ("External object '%s' at %L may not have an initializer",
- sym->name, &sym->declared_at);
- return;
- }
-
break;
}