* [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).