diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/fortran/ChangeLog | 8 | ||||
| -rw-r--r-- | gcc/fortran/gfortran.h | 1 | ||||
| -rw-r--r-- | gcc/fortran/interface.c | 4 | ||||
| -rw-r--r-- | gcc/fortran/resolve.c | 10 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 4 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/dtio_35.f90 | 50 |
6 files changed, 71 insertions, 6 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index c4ca48f..8c4ace7 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,5 +1,13 @@ 2020-04-02 Tobias Burnus <tobias@codesourcery.com> + * gfortran.h (gfc_resolve_formal_arglist): Add prototype. + * interface.c (check_dtio_interface1): Call it. + * resolve.c (gfc_resolve_formal_arglist): Renamed from + resolve_formal_arglist, removed static. + (find_arglists, resolve_types): Update calls. + +2020-04-02 Tobias Burnus <tobias@codesourcery.com> + PR fortran/93522 * match.c (gfc_match_select_rank): Fix error cleanup. diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 9603762..88e4d92 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -3369,6 +3369,7 @@ bool gfc_resolve_expr (gfc_expr *); void gfc_resolve (gfc_namespace *); void gfc_resolve_code (gfc_code *, gfc_namespace *); void gfc_resolve_blocks (gfc_code *, gfc_namespace *); +void gfc_resolve_formal_arglist (gfc_symbol *); int gfc_impure_variable (gfc_symbol *); int gfc_pure (gfc_symbol *); int gfc_implicit_pure (gfc_symbol *); diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index 14d03c2..75a50c9 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -5007,6 +5007,9 @@ check_dtio_interface1 (gfc_symbol *derived, gfc_symtree *tb_io_st, gfc_error ("DTIO procedure %qs at %L must be a subroutine", dtio_sub->name, &dtio_sub->declared_at); + if (!dtio_sub->resolved) + gfc_resolve_formal_arglist (dtio_sub); + arg_num = 0; for (formal = dtio_sub->formal; formal; formal = formal->next) arg_num++; @@ -5025,7 +5028,6 @@ check_dtio_interface1 (gfc_symbol *derived, gfc_symtree *tb_io_st, return; } - /* Now go through the formal arglist. */ arg_num = 1; for (formal = dtio_sub->formal; formal; formal = formal->next, arg_num++) diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 79b0d72..97de6dd 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -264,8 +264,8 @@ resolve_procedure_interface (gfc_symbol *sym) Since a dummy argument cannot be a non-dummy procedure, the only resort left for untyped names are the IMPLICIT types. */ -static void -resolve_formal_arglist (gfc_symbol *proc) +void +gfc_resolve_formal_arglist (gfc_symbol *proc) { gfc_formal_arglist *f; gfc_symbol *sym; @@ -319,7 +319,7 @@ resolve_formal_arglist (gfc_symbol *proc) } if (sym->attr.if_source != IFSRC_UNKNOWN) - resolve_formal_arglist (sym); + gfc_resolve_formal_arglist (sym); if (sym->attr.subroutine || sym->attr.external) { @@ -547,7 +547,7 @@ find_arglists (gfc_symbol *sym) || gfc_fl_struct (sym->attr.flavor) || sym->attr.intrinsic) return; - resolve_formal_arglist (sym); + gfc_resolve_formal_arglist (sym); } @@ -17159,7 +17159,7 @@ resolve_types (gfc_namespace *ns) if (ns->proc_name && ns->proc_name->attr.flavor == FL_PROCEDURE && ns->proc_name->attr.if_source == IFSRC_IFBODY) - resolve_formal_arglist (ns->proc_name); + gfc_resolve_formal_arglist (ns->proc_name); gfc_traverse_ns (ns, resolve_bind_c_derived_types); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index c3803b6..c28b001 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2020-04-02 Tobias Burnus <tobias@codesourcery.com> + + * gfortran.dg/dtio_35.f90: New. + 2020-04-02 Richard Biener <rguenther@suse.de> PR c/94392 diff --git a/gcc/testsuite/gfortran.dg/dtio_35.f90 b/gcc/testsuite/gfortran.dg/dtio_35.f90 new file mode 100644 index 0000000..d7211df --- /dev/null +++ b/gcc/testsuite/gfortran.dg/dtio_35.f90 @@ -0,0 +1,50 @@ +! { dg-compile } +! +! Reported by Vladimir Nikishkin +! at https://stackoverflow.com/questions/60972134/whats-wrong-with-the-following-fortran-code-gfortran-dtio-dummy-argument-at# +! + +module scheme + + type, abstract :: scheme_object + contains + procedure, pass :: generic_scheme_print => print_scheme_object + generic, public :: write (formatted) => generic_scheme_print + end type scheme_object + + abstract interface + subroutine packageable_procedure( ) + import scheme_object + end subroutine packageable_procedure + end interface +contains + + subroutine print_scheme_object(this, unit, iotype, v_list, iostat, iomsg) + class(scheme_object), intent(in) :: this + integer, intent(in) :: unit + character(*), intent(in) :: iotype + integer, intent(in) :: v_list (:) + integer, intent(out) :: iostat + character(*), intent(inout) :: iomsg + iostat = 1 + end subroutine print_scheme_object + + subroutine packaged_cons( ) + end subroutine packaged_cons + + function make_primitive_procedure_object( proc1 ) result( retval ) + class(scheme_object), pointer :: retval + procedure(packageable_procedure), pointer :: proc1 + end function make_primitive_procedure_object + + subroutine ll_setup_global_environment() + procedure(packageable_procedure), pointer :: proc1 + class(scheme_object), pointer :: proc_obj_to_pack + proc1 => packaged_cons + proc_obj_to_pack => make_primitive_procedure_object( proc1 ) + end subroutine ll_setup_global_environment + +end module scheme + +program main +end program main |