diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/fortran/ChangeLog | 10 | ||||
| -rw-r--r-- | gcc/fortran/interface.c | 10 | ||||
| -rw-r--r-- | gcc/fortran/resolve.c | 82 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 10 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/altreturn_10.f90 | 19 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/whole_file_3.f90 | 4 |
6 files changed, 89 insertions, 46 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index dd4347e..3ce7de3 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,13 @@ +2019-03-24 Thomas Koenig <tkoenig@gcc.gnu.org> + + PR fortran/78865 + * interface.c (compare_actual_formal): Change errors about + missing or extra to gfc_error_now to make sure they are issued. + Change "spec" to "specifier" in message. + * resolve.c (resolve_global_procedure): Also check for mismatching + interface with global symbols if the namespace has already been + resolved. + 2019-03-21 Thomas Schwinge <thomas@codesourcery.com> PR fortran/72741 diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index c9781d7..5b8a0f9 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -2969,17 +2969,19 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, if (f->sym == NULL) { + /* These errors have to be issued, otherwise an ICE can occur. + See PR 78865. */ if (where) - gfc_error ("Missing alternate return spec in subroutine call " - "at %L", where); + gfc_error_now ("Missing alternate return specifier in subroutine " + "call at %L", where); return false; } if (a->expr == NULL) { if (where) - gfc_error ("Unexpected alternate return spec in subroutine " - "call at %L", where); + gfc_error_now ("Unexpected alternate return specifier in " + "subroutine call at %L", where); return false; } diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index e1cd200..3513a44 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -2498,62 +2498,64 @@ resolve_global_procedure (gfc_symbol *sym, locus *where, && gsym->type != GSYM_UNKNOWN && !gsym->binding_label && gsym->ns - && gsym->ns->resolved != -1 && gsym->ns->proc_name && not_in_recursive (sym, gsym->ns) && not_entry_self_reference (sym, gsym->ns)) { gfc_symbol *def_sym; + def_sym = gsym->ns->proc_name; - /* Resolve the gsymbol namespace if needed. */ - if (!gsym->ns->resolved) + if (gsym->ns->resolved != -1) { - gfc_symbol *old_dt_list; - /* Stash away derived types so that the backend_decls do not - get mixed up. */ - old_dt_list = gfc_derived_types; - gfc_derived_types = NULL; + /* Resolve the gsymbol namespace if needed. */ + if (!gsym->ns->resolved) + { + gfc_symbol *old_dt_list; - gfc_resolve (gsym->ns); + /* Stash away derived types so that the backend_decls + do not get mixed up. */ + old_dt_list = gfc_derived_types; + gfc_derived_types = NULL; - /* Store the new derived types with the global namespace. */ - if (gfc_derived_types) - gsym->ns->derived_types = gfc_derived_types; + gfc_resolve (gsym->ns); - /* Restore the derived types of this namespace. */ - gfc_derived_types = old_dt_list; - } + /* Store the new derived types with the global namespace. */ + if (gfc_derived_types) + gsym->ns->derived_types = gfc_derived_types; - /* Make sure that translation for the gsymbol occurs before - the procedure currently being resolved. */ - ns = gfc_global_ns_list; - for (; ns && ns != gsym->ns; ns = ns->sibling) - { - if (ns->sibling == gsym->ns) - { - ns->sibling = gsym->ns->sibling; - gsym->ns->sibling = gfc_global_ns_list; - gfc_global_ns_list = gsym->ns; - break; + /* Restore the derived types of this namespace. */ + gfc_derived_types = old_dt_list; } - } - def_sym = gsym->ns->proc_name; + /* Make sure that translation for the gsymbol occurs before + the procedure currently being resolved. */ + ns = gfc_global_ns_list; + for (; ns && ns != gsym->ns; ns = ns->sibling) + { + if (ns->sibling == gsym->ns) + { + ns->sibling = gsym->ns->sibling; + gsym->ns->sibling = gfc_global_ns_list; + gfc_global_ns_list = gsym->ns; + break; + } + } - /* This can happen if a binding name has been specified. */ - if (gsym->binding_label && gsym->sym_name != def_sym->name) - gfc_find_symbol (gsym->sym_name, gsym->ns, 0, &def_sym); + /* This can happen if a binding name has been specified. */ + if (gsym->binding_label && gsym->sym_name != def_sym->name) + gfc_find_symbol (gsym->sym_name, gsym->ns, 0, &def_sym); - if (def_sym->attr.entry_master) - { - gfc_entry_list *entry; - for (entry = gsym->ns->entries; entry; entry = entry->next) - if (strcmp (entry->sym->name, sym->name) == 0) - { - def_sym = entry->sym; - break; - } + if (def_sym->attr.entry_master) + { + gfc_entry_list *entry; + for (entry = gsym->ns->entries; entry; entry = entry->next) + if (strcmp (entry->sym->name, sym->name) == 0) + { + def_sym = entry->sym; + break; + } + } } if (sym->attr.function && !gfc_compare_types (&sym->ts, &def_sym->ts)) diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 5626696..7d2a0b1 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,13 @@ +2019-03-24 Thomas Koenig <tkoenig@gcc.gnu.org> + + PR fortran/78865 + * interface.c (compare_actual_formal): Change errors about + missing or extra to gfc_error_now to make sure they are issued. + Change "spec" to "specifier" in message. + * resolve.c (resolve_global_procedure): Also check for mismatching + interface with global symbols if the namespace has already been + resolved. + 2019-03-22 Vladimir Makarov <vmakarov@redhat.com> PR rtl-optimization/89676 diff --git a/gcc/testsuite/gfortran.dg/altreturn_10.f90 b/gcc/testsuite/gfortran.dg/altreturn_10.f90 new file mode 100644 index 0000000..7e5d569 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/altreturn_10.f90 @@ -0,0 +1,19 @@ +! { dg-do compile } +! { dg-options -Os } +! PR 78865 - this used to ICE. +program p + call sub (3) +end +subroutine sub (x) + integer :: x, i, n + do i = 1, x + if ( n /= 0 ) stop + call sub2 + end do + print *, x, n +end +subroutine sub2 + call sub (*99) ! { dg-error "Unexpected alternate return specifier" } + call sub (99.) ! { dg-warning "Type mismatch in argument" } +99 stop +end diff --git a/gcc/testsuite/gfortran.dg/whole_file_3.f90 b/gcc/testsuite/gfortran.dg/whole_file_3.f90 index 9b4f5a7..0689827 100644 --- a/gcc/testsuite/gfortran.dg/whole_file_3.f90 +++ b/gcc/testsuite/gfortran.dg/whole_file_3.f90 @@ -14,8 +14,8 @@ program test EXTERNAL R - call PHLOAD (R, 1) ! { dg-warning "Missing alternate return spec" } - CALL PHLOAD (R, 2) ! { dg-warning "Missing alternate return spec" } + call PHLOAD (R, 1) ! { dg-error "Missing alternate return specifier" } + CALL PHLOAD (R, 2) ! { dg-error "Missing alternate return specifier" } CALL PHLOAD (R, *999) ! This one is OK 999 continue END program test |