* [PATCH] deferred-shape vs assumed-shape @ 2020-04-01 20:04 Steve Kargl 2020-04-02 9:34 ` [Patch][Fortran] Resolve formal args before checking DTIO (was: Re: [PATCH] deferred-shape vs assumed-shape) Tobias Burnus 0 siblings, 1 reply; 3+ messages in thread From: Steve Kargl @ 2020-04-01 20:04 UTC (permalink / raw) To: fortran, gcc-patches See https://stackoverflow.com/questions/60972134/whats-wrong-with-the-following-fortran-code-gfortran-dtio-dummy-argument-at Is A(:) a deferred-shape array or an assumed-shape array? The answer of course depends on context. This patch fixes the issue found at the above URL. Index: gcc/fortran/interface.c =================================================================== --- gcc/fortran/interface.c (revision 280157) +++ gcc/fortran/interface.c (working copy) @@ -4916,10 +4916,15 @@ check_dtio_arg_TKR_intent (gfc_symbol *fsym, bool type || ((type != BT_CLASS) && fsym->attr.dimension))) gfc_error ("DTIO dummy argument at %L must be a scalar", &fsym->declared_at); - else if (rank == 1 - && (fsym->as == NULL || fsym->as->type != AS_ASSUMED_SHAPE)) - gfc_error ("DTIO dummy argument at %L must be an " - "ASSUMED SHAPE ARRAY", &fsym->declared_at); + else if (rank == 1) + { + if (fsym->as == NULL + || !(fsym->as->type == AS_ASSUMED_SHAPE + || (fsym->as->type == AS_DEFERRED && fsym->attr.dummy + && !fsym->attr.allocatable && !fsym->attr.pointer))) + gfc_error ("DTIO dummy argument at %L must be an " + "ASSUMED-SHAPE ARRAY", &fsym->declared_at); + } if (type == BT_CHARACTER && fsym->ts.u.cl->length != NULL) gfc_error ("DTIO character argument at %L must have assumed length", -- Steve ^ permalink raw reply [flat|nested] 3+ messages in thread
* [Patch][Fortran] Resolve formal args before checking DTIO (was: Re: [PATCH] deferred-shape vs assumed-shape) 2020-04-01 20:04 [PATCH] deferred-shape vs assumed-shape Steve Kargl @ 2020-04-02 9:34 ` Tobias Burnus 2020-04-02 15:05 ` Steve Kargl 0 siblings, 1 reply; 3+ messages in thread From: Tobias Burnus @ 2020-04-02 9:34 UTC (permalink / raw) To: sgk, fortran, gcc-patches [-- Attachment #1: Type: text/plain, Size: 2375 bytes --] Hi Steve, I think your patch is fine - however, I think calling the normal resolve_formal_arglist looks a bit cleaner to me (as done in the attached patch). — Additionally, I added the testcase. Side effect of my variant is that gfc_check_dtio_interfaces will be called again a bit later again. — In this sense, Steve's patch, which replicates a chunk of resolve_formal_arglist, is better. Thoughts by anyone? OK? Tobias PS: I was thinking of calling resolve_symbol instead but this one does not resolve the formal arguments (via "gfc_resolve (sym->formal_ns)") as sym->attr.contained. On 4/1/20 10:04 PM, Steve Kargl via Fortran wrote: > See > https://stackoverflow.com/questions/60972134/whats-wrong-with-the-following-fortran-code-gfortran-dtio-dummy-argument-at > > Is A(:) a deferred-shape array or an assumed-shape array? The > answer of course depends on context. > > This patch fixes the issue found at the above URL. > > Index: gcc/fortran/interface.c > =================================================================== > --- gcc/fortran/interface.c (revision 280157) > +++ gcc/fortran/interface.c (working copy) > @@ -4916,10 +4916,15 @@ check_dtio_arg_TKR_intent (gfc_symbol *fsym, bool type > || ((type != BT_CLASS) && fsym->attr.dimension))) > gfc_error ("DTIO dummy argument at %L must be a scalar", > &fsym->declared_at); > - else if (rank == 1 > - && (fsym->as == NULL || fsym->as->type != AS_ASSUMED_SHAPE)) > - gfc_error ("DTIO dummy argument at %L must be an " > - "ASSUMED SHAPE ARRAY", &fsym->declared_at); > + else if (rank == 1) > + { > + if (fsym->as == NULL > + || !(fsym->as->type == AS_ASSUMED_SHAPE > + || (fsym->as->type == AS_DEFERRED && fsym->attr.dummy > + && !fsym->attr.allocatable && !fsym->attr.pointer))) > + gfc_error ("DTIO dummy argument at %L must be an " > + "ASSUMED-SHAPE ARRAY", &fsym->declared_at); > + } > > if (type == BT_CHARACTER && fsym->ts.u.cl->length != NULL) > gfc_error ("DTIO character argument at %L must have assumed length", > ----------------- Mentor Graphics (Deutschland) GmbH, Arnulfstraße 201, 80634 München / Germany Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Alexander Walter [-- Attachment #2: dtio.diff --] [-- Type: text/x-patch, Size: 5073 bytes --] [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. gcc/fortran/gfortran.h | 1 + gcc/fortran/interface.c | 4 ++- gcc/fortran/resolve.c | 10 +++---- gcc/testsuite/gfortran.dg/dtio_35.f90 | 50 +++++++++++++++++++++++++++++++++++ 4 files changed, 59 insertions(+), 6 deletions(-) diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 96037629f5f..88e4d9236f3 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 14d03c27759..75a50c999b7 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 79b0d724565..97de6ddce84 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/gfortran.dg/dtio_35.f90 b/gcc/testsuite/gfortran.dg/dtio_35.f90 new file mode 100644 index 00000000000..d7211df87ac --- /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 ^ permalink raw reply [flat|nested] 3+ messages in thread
* Re: [Patch][Fortran] Resolve formal args before checking DTIO (was: Re: [PATCH] deferred-shape vs assumed-shape) 2020-04-02 9:34 ` [Patch][Fortran] Resolve formal args before checking DTIO (was: Re: [PATCH] deferred-shape vs assumed-shape) Tobias Burnus @ 2020-04-02 15:05 ` Steve Kargl 0 siblings, 0 replies; 3+ messages in thread From: Steve Kargl @ 2020-04-02 15:05 UTC (permalink / raw) To: Tobias Burnus; +Cc: fortran, gcc-patches This one is a little bit wierd for me. It seems AS_DEFERRED is overloaded and things get fixed up later. In array.c one finds match_array_element_spec(), which set AS_DEFERRED if the matchers sees (:) regardless of how the array is used. Then in gfc_set_array_spec(), the array spec is attached to the symbol in this block if (sym->as == NULL) { sym->as = as; return true; } We can check sym->attr to determine if this is a nonallocatable nonpointer dummy argument and reset the type to AS_ASSUMED_SHAPE; or at least I though tI could. This leads to a very, very, long list of regressions. So, I went with the direct hammer. Your patch is fine with me as it likely resolves (fixes up?) the symbol for future references. -- steve On Thu, Apr 02, 2020 at 11:34:16AM +0200, Tobias Burnus wrote: > Hi Steve, > > I think your patch is fine - however, I think calling the normal > resolve_formal_arglist looks a bit cleaner to me (as done in the > attached patch). — Additionally, I added the testcase. > > Side effect of my variant is that gfc_check_dtio_interfaces will > be called again a bit later again. — In this sense, Steve's patch, > which replicates a chunk of resolve_formal_arglist, is better. > > Thoughts by anyone? > > OK? > > Tobias > > PS: I was thinking of calling resolve_symbol instead > but this one does not resolve the formal arguments > (via "gfc_resolve (sym->formal_ns)") as sym->attr.contained. > > On 4/1/20 10:04 PM, Steve Kargl via Fortran wrote: > > > See > > https://stackoverflow.com/questions/60972134/whats-wrong-with-the-following-fortran-code-gfortran-dtio-dummy-argument-at > > > > Is A(:) a deferred-shape array or an assumed-shape array? The > > answer of course depends on context. > > > > This patch fixes the issue found at the above URL. > > > > Index: gcc/fortran/interface.c > > =================================================================== > > --- gcc/fortran/interface.c (revision 280157) > > +++ gcc/fortran/interface.c (working copy) > > @@ -4916,10 +4916,15 @@ check_dtio_arg_TKR_intent (gfc_symbol *fsym, bool type > > || ((type != BT_CLASS) && fsym->attr.dimension))) > > gfc_error ("DTIO dummy argument at %L must be a scalar", > > &fsym->declared_at); > > - else if (rank == 1 > > - && (fsym->as == NULL || fsym->as->type != AS_ASSUMED_SHAPE)) > > - gfc_error ("DTIO dummy argument at %L must be an " > > - "ASSUMED SHAPE ARRAY", &fsym->declared_at); > > + else if (rank == 1) > > + { > > + if (fsym->as == NULL > > + || !(fsym->as->type == AS_ASSUMED_SHAPE > > + || (fsym->as->type == AS_DEFERRED && fsym->attr.dummy > > + && !fsym->attr.allocatable && !fsym->attr.pointer))) > > + gfc_error ("DTIO dummy argument at %L must be an " > > + "ASSUMED-SHAPE ARRAY", &fsym->declared_at); > > + } > > > > if (type == BT_CHARACTER && fsym->ts.u.cl->length != NULL) > > gfc_error ("DTIO character argument at %L must have assumed length", > > > ----------------- > Mentor Graphics (Deutschland) GmbH, Arnulfstraße 201, 80634 München / Germany > Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Alexander Walter > [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. > > gcc/fortran/gfortran.h | 1 + > gcc/fortran/interface.c | 4 ++- > gcc/fortran/resolve.c | 10 +++---- > gcc/testsuite/gfortran.dg/dtio_35.f90 | 50 +++++++++++++++++++++++++++++++++++ > 4 files changed, 59 insertions(+), 6 deletions(-) > > diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h > index 96037629f5f..88e4d9236f3 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 14d03c27759..75a50c999b7 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 79b0d724565..97de6ddce84 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/gfortran.dg/dtio_35.f90 b/gcc/testsuite/gfortran.dg/dtio_35.f90 > new file mode 100644 > index 00000000000..d7211df87ac > --- /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 -- Steve 20170425 https://www.youtube.com/watch?v=VWUpyCsUKR4 20161221 https://www.youtube.com/watch?v=IbCHE-hONow ^ permalink raw reply [flat|nested] 3+ messages in thread
end of thread, other threads:[~2020-04-02 15:05 UTC | newest] Thread overview: 3+ messages (download: mbox.gz / follow: Atom feed) -- links below jump to the message on this page -- 2020-04-01 20:04 [PATCH] deferred-shape vs assumed-shape Steve Kargl 2020-04-02 9:34 ` [Patch][Fortran] Resolve formal args before checking DTIO (was: Re: [PATCH] deferred-shape vs assumed-shape) Tobias Burnus 2020-04-02 15:05 ` Steve Kargl
This is a public inbox, see mirroring instructions for how to clone and mirror all data and code used for this inbox; as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).