aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
authorTobias Burnus <tobias@codesourcery.com>2020-04-02 18:27:09 +0200
committerTobias Burnus <tobias@codesourcery.com>2020-04-02 18:27:09 +0200
commit3ab216a4d2f14be1f37350260142c91fabce834a (patch)
treea6a5e77601a0f9a6252e865003a91f7f9002a071 /gcc
parentb90061c6ec090c6b41a44987c646c828e5165298 (diff)
downloadgcc-3ab216a4d2f14be1f37350260142c91fabce834a.zip
gcc-3ab216a4d2f14be1f37350260142c91fabce834a.tar.gz
gcc-3ab216a4d2f14be1f37350260142c91fabce834a.tar.bz2
[Fortran] Resolve formal args before checking DTIO
* 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. * gfortran.dg/dtio_35.f90: New.
Diffstat (limited to 'gcc')
-rw-r--r--gcc/fortran/ChangeLog8
-rw-r--r--gcc/fortran/gfortran.h1
-rw-r--r--gcc/fortran/interface.c4
-rw-r--r--gcc/fortran/resolve.c10
-rw-r--r--gcc/testsuite/ChangeLog4
-rw-r--r--gcc/testsuite/gfortran.dg/dtio_35.f9050
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