diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/fortran/ChangeLog | 18 | ||||
| -rw-r--r-- | gcc/fortran/gfortran.h | 2 | ||||
| -rw-r--r-- | gcc/fortran/module.c | 64 | ||||
| -rw-r--r-- | gcc/fortran/resolve.c | 32 | ||||
| -rw-r--r-- | gcc/fortran/trans-array.c | 13 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 8 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/entry_array_specs_2.f | 31 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/nested_modules_6.f90 | 35 |
8 files changed, 181 insertions, 22 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index d25f5bf..c47a3b8 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,21 @@ +2006-12-22 Paul Thomas <pault@gcc.gnu.org> + + 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-21 Roger Sayle <roger@eyesopen.com> * trans-array.c (gfc_trans_create_temp_array): When the size is known diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 296004e..6286297 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -480,7 +480,7 @@ typedef struct /* Variable attributes. */ unsigned allocatable:1, dimension:1, external:1, intrinsic:1, optional:1, pointer:1, save:1, target:1, value:1, volatile_:1, - dummy:1, result:1, assign:1, threadprivate:1; + dummy:1, result:1, assign:1, threadprivate:1, not_always_present:1; unsigned data:1, /* Symbol is named in a DATA statement. */ protected:1, /* Symbol has been marked as protected. */ 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: diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 519d92ab..eaa939d 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -342,6 +342,33 @@ merge_argument_lists (gfc_symbol *proc, gfc_formal_arglist *new_args) } +/* Flag the arguments that are not present in all entries. */ + +static void +check_argument_lists (gfc_symbol *proc, gfc_formal_arglist *new_args) +{ + gfc_formal_arglist *f, *head; + head = new_args; + + for (f = proc->formal; f; f = f->next) + { + if (f->sym == NULL) + continue; + + for (new_args = head; new_args; new_args = new_args->next) + { + if (new_args->sym == f->sym) + break; + } + + if (new_args) + continue; + + f->sym->attr.not_always_present = 1; + } +} + + /* Resolve alternate entry points. If a symbol has multiple entry points we create a new master symbol for the main routine, and turn the existing symbol into an entry point. */ @@ -541,6 +568,11 @@ resolve_entries (gfc_namespace * ns) for (el = ns->entries; el; el = el->next) merge_argument_lists (proc, el->sym->formal); + /* Check the master formal arguments for any that are not + present in all entry points. */ + for (el = ns->entries; el; el = el->next) + check_argument_lists (proc, el->sym->formal); + /* Use the master function for the function body. */ ns->proc_name = proc; diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 56e69a3..10243fe 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -3767,6 +3767,7 @@ gfc_trans_g77_array (gfc_symbol * sym, tree body) locus loc; tree offset; tree tmp; + tree stmt; stmtblock_t block; gfc_get_backend_locus (&loc); @@ -3796,13 +3797,21 @@ gfc_trans_g77_array (gfc_symbol * sym, tree body) tmp = convert (TREE_TYPE (parm), GFC_DECL_SAVED_DESCRIPTOR (parm)); gfc_add_modify_expr (&block, parm, tmp); } - tmp = gfc_finish_block (&block); + stmt = gfc_finish_block (&block); gfc_set_backend_locus (&loc); gfc_start_block (&block); + /* Add the initialization code to the start of the function. */ - gfc_add_expr_to_block (&block, tmp); + + if (sym->attr.optional || sym->attr.not_always_present) + { + tmp = gfc_conv_expr_present (sym); + stmt = build3_v (COND_EXPR, tmp, stmt, build_empty_stmt ()); + } + + gfc_add_expr_to_block (&block, stmt); gfc_add_expr_to_block (&block, body); return gfc_finish_block (&block); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 5fc63cf..c452eb4 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,11 @@ +2006-12-22 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/25818 + * gfortran.dg/entry_array_specs_2.f: New test. + + PR fortran/30084 + * gfortran.dg/nested_modules_6.f90: New test. + 2006-12-22 Manuel Lopez-Ibanez <manu@gcc.gnu.org> PR middle-end/7651 diff --git a/gcc/testsuite/gfortran.dg/entry_array_specs_2.f b/gcc/testsuite/gfortran.dg/entry_array_specs_2.f new file mode 100644 index 0000000..ba4de31 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/entry_array_specs_2.f @@ -0,0 +1,31 @@ +! { dg-do run } +! Tests the patch for PR30025, aka 25818, in which the initialization +! code for the array a, was causing a segfault in runtime for a call +! to x, since n is missing. +! +! COntributed by Elizabeth Yip <elizabeth.l.yip@boeing.com> + program test_entry + common // j + real a(10) + a(1) = 999. + call x + if (j .ne. 1) call abort () + call y(a,10) + if (j .ne. 2) call abort () + stop + end + subroutine x + common // j + real a(n) + j = 1 + return + entry y(a,n) + call foo(a(1)) + end + subroutine foo(a) + common // j + real a + j = 2 + return + end + diff --git a/gcc/testsuite/gfortran.dg/nested_modules_6.f90 b/gcc/testsuite/gfortran.dg/nested_modules_6.f90 new file mode 100644 index 0000000..c967aaa --- /dev/null +++ b/gcc/testsuite/gfortran.dg/nested_modules_6.f90 @@ -0,0 +1,35 @@ +! { dg-do compile } +! Test the patch for PR30084 in which the reference to SIZE +! in function diag caused a segfault in module.c. +! +! Contributed by Troban Trumsko <trumsko@yahoo.com> +! and reduced by Steve Kargl <kargl@gcc.gnu.org> +! +module tao_random_numbers + integer, dimension(10) :: s_buffer + integer :: s_last = size (s_buffer) +end module tao_random_numbers + +module linalg + contains + function diag (a) result (d) + real, dimension(:,:), intent(in) :: a + real, dimension(min(size(a,dim=1),size(a,dim=2))) :: d + integer :: i + do i = 1, min(size(a, dim = 1), size(a, dim = 2)) + d(i) = a(i,i) + end do + end function diag +end module linalg + +module vamp_rest + use tao_random_numbers + use linalg +end module vamp_rest + + use vamp_rest + real :: x(2, 2) = reshape ([1.,2.,3.,4.], [2,2]) ! { dg-warning "nonstandard" } + print *, s_last + print *, diag (x) +end +! { dg-final { cleanup-modules "tao_random_numbers linalg vamp_rest" } } |