From 54129a64cd5ec8254cdf7cc735537f14cb3c27d7 Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Fri, 22 Dec 2006 20:49:00 +0000 Subject: re PR fortran/25818 ([4.1 only] Problem with handling optional and entry master arguments) 2006-12-22 Paul Thomas PR fortran/25818 * trans-array.c (gfc_trans_g77_array): If the variable is optional or not always present, make the statement conditional on presence of the argument. * gfortran.h : Add symbol_attribute not_always_present. * resolve.c (check_argument_lists): New function to check if arguments are not present in all entries. PR fortran/30084 * module.c (mio_component_ref): Move treatment of unique name variables, during output, to fix_mio_expr. (fix_mio_expr): New function that fixes defective expressions before they are written to the module file. (mio_expr): Call the new function. (resolve_entries): Call check_argument_lists. 2006-12-22 Paul Thomas PR fortran/25818 * gfortran.dg/entry_array_specs_2.f: New test. PR fortran/30084 * gfortran.dg/nested_modules_6.f90: New test. From-SVN: r120155 --- gcc/fortran/module.c | 64 ++++++++++++++++++++++++++++++++++++---------------- 1 file changed, 45 insertions(+), 19 deletions(-) (limited to 'gcc/fortran/module.c') diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c index f54ef8e..dc138d3 100644 --- a/gcc/fortran/module.c +++ b/gcc/fortran/module.c @@ -2194,27 +2194,9 @@ mio_symtree_ref (gfc_symtree ** stp) { pointer_info *p; fixup_t *f; - gfc_symtree * ns_st = NULL; if (iomode == IO_OUTPUT) - { - /* If this is a symtree for a symbol that came from a contained module - namespace, it has a unique name and we should look in the current - namespace to see if the required, non-contained symbol is available - yet. If so, the latter should be written. */ - if ((*stp)->n.sym && check_unique_name((*stp)->name)) - ns_st = gfc_find_symtree (gfc_current_ns->sym_root, - (*stp)->n.sym->name); - - /* On the other hand, if the existing symbol is the module name or the - new symbol is a dummy argument, do not do the promotion. */ - if (ns_st && ns_st->n.sym - && ns_st->n.sym->attr.flavor != FL_MODULE - && !(*stp)->n.sym->attr.dummy) - mio_symbol_ref (&ns_st->n.sym); - else - mio_symbol_ref (&(*stp)->n.sym); - } + mio_symbol_ref (&(*stp)->n.sym); else { require_atom (ATOM_INTEGER); @@ -2554,6 +2536,48 @@ static const mstring intrinsics[] = minit (NULL, -1) }; + +/* Remedy a couple of situations where the gfc_expr's can be defective. */ + +static void +fix_mio_expr (gfc_expr *e) +{ + gfc_symtree *ns_st = NULL; + const char *fname; + + if (iomode != IO_OUTPUT) + return; + + if (e->symtree) + { + /* If this is a symtree for a symbol that came from a contained module + namespace, it has a unique name and we should look in the current + namespace to see if the required, non-contained symbol is available + yet. If so, the latter should be written. */ + if (e->symtree->n.sym && check_unique_name(e->symtree->name)) + ns_st = gfc_find_symtree (gfc_current_ns->sym_root, + e->symtree->n.sym->name); + + /* On the other hand, if the existing symbol is the module name or the + new symbol is a dummy argument, do not do the promotion. */ + if (ns_st && ns_st->n.sym + && ns_st->n.sym->attr.flavor != FL_MODULE + && !e->symtree->n.sym->attr.dummy) + e->symtree = ns_st; + } + else if (e->expr_type == EXPR_FUNCTION && e->value.function.name) + { + /* In some circumstances, a function used in an initialization + expression, in one use associated module, can fail to be + coupled to its symtree when used in a specification + expression in another module. */ + fname = e->value.function.esym ? e->value.function.esym->name : + e->value.function.isym->name; + e->symtree = gfc_find_symtree (gfc_current_ns->sym_root, fname); + } +} + + /* Read and write expressions. The form "()" is allowed to indicate a NULL expression. */ @@ -2598,6 +2622,8 @@ mio_expr (gfc_expr ** ep) mio_typespec (&e->ts); mio_integer (&e->rank); + fix_mio_expr (e); + switch (e->expr_type) { case EXPR_OP: -- cgit v1.1