public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc r10-9180] This patch fixes PR96320. See the explanatory comment in the testcase.
@ 2020-12-28 14:55 Paul Thomas
0 siblings, 0 replies; only message in thread
From: Paul Thomas @ 2020-12-28 14:55 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:c2840cf16aaa665aaac4f51345104c5766fb2406
commit r10-9180-gc2840cf16aaa665aaac4f51345104c5766fb2406
Author: Paul Thomas <pault@gcc.gnu.org>
Date: Sun Aug 2 10:57:59 2020 +0100
This patch fixes PR96320. See the explanatory comment in the testcase.
2020-08-01 Paul Thomas <pault@gcc.gnu.org>
gcc/fortran
PR target/96320
* interface.c (gfc_check_dummy_characteristics): If a module
procedure arrives with assumed shape in the interface and
deferred shape in the procedure itself, update the latter and
copy the lower bounds.
gcc/testsuite/
PR target/96320
* gfortran.dg/module_procedure_4.f90 : New test.
(cherry picked from commit a5baf71b0a5bd79923c095cf81218b8194008f60)
Diff:
---
gcc/fortran/interface.c | 19 +++++--
gcc/testsuite/gfortran.dg/module_procedure_4.f90 | 63 ++++++++++++++++++++++++
2 files changed, 79 insertions(+), 3 deletions(-)
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index b1a75a37b0e..70219a537b9 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -1465,6 +1465,19 @@ gfc_check_dummy_characteristics (gfc_symbol *s1, gfc_symbol *s2,
int i, compval;
gfc_expr *shape1, *shape2;
+ /* Sometimes the ambiguity between deferred shape and assumed shape
+ does not get resolved in module procedures, where the only explicit
+ declaration of the dummy is in the interface. */
+ if (s1->ns->proc_name && s1->ns->proc_name->attr.module_procedure
+ && s1->as->type == AS_ASSUMED_SHAPE
+ && s2->as->type == AS_DEFERRED)
+ {
+ s2->as->type = AS_ASSUMED_SHAPE;
+ for (i = 0; i < s2->as->rank; i++)
+ if (s1->as->lower[i] != NULL)
+ s2->as->lower[i] = gfc_copy_expr (s1->as->lower[i]);
+ }
+
if (s1->as->type != s2->as->type)
{
snprintf (errmsg, err_len, "Shape mismatch in argument '%s'",
@@ -2616,7 +2629,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
|| (actual->rank == 0 && formal->attr.dimension
&& gfc_is_coindexed (actual)))
{
- if (where
+ if (where
&& (!formal->attr.artificial || (!formal->maybe_array
&& !maybe_dummy_array_arg (actual))))
{
@@ -2707,7 +2720,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
if (ref == NULL && actual->expr_type != EXPR_NULL)
{
- if (where
+ if (where
&& (!formal->attr.artificial || (!formal->maybe_array
&& !maybe_dummy_array_arg (actual))))
{
@@ -3964,7 +3977,7 @@ gfc_procedure_use (gfc_symbol *sym, gfc_actual_arglist **ap, locus *where)
if (!gfc_compare_actual_formal (ap, dummy_args, 0, sym->attr.elemental,
sym->attr.proc == PROC_ST_FUNCTION, where))
return false;
-
+
if (!check_intents (dummy_args, *ap))
return false;
diff --git a/gcc/testsuite/gfortran.dg/module_procedure_4.f90 b/gcc/testsuite/gfortran.dg/module_procedure_4.f90
new file mode 100644
index 00000000000..c30bbfe5d50
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/module_procedure_4.f90
@@ -0,0 +1,63 @@
+! { dg-do run }
+!
+! Test the fix for PR96320 in which the assumed shape of 'arg' in the
+! interface for 'bar' was mirrored by the 'arg' in the module procedure
+! incorrectly have deferred shape.
+!
+! Contributed by Damian Rouson <damian@sourceryinstitute.org>
+!
+module foobar
+ type foo
+ contains
+ procedure, nopass :: bar1
+ procedure, nopass :: bar2
+ procedure, nopass :: bar3
+ end type
+
+ interface
+
+ module subroutine bar1(arg)
+ character(len=*) arg(:)
+ end subroutine
+
+ module subroutine bar2(arg)
+ character(len=*) arg(3:)
+ end subroutine
+
+ module subroutine bar3(arg)
+ character(len=*) arg(2)
+ end subroutine
+
+ end interface
+contains
+
+ module procedure bar1
+ if (lbound(arg, 1) .ne. 1) stop 1
+ if (arg(3) .ne. 'hijk') stop 2
+ end procedure
+
+! Make sure that the lower bound of an assumed shape array dummy,
+! if defined, is passed to the module procedure.
+
+ module procedure bar2
+ if (lbound(arg, 1) .ne. 3) stop 3
+ if (arg(3) .ne. 'abcd') stop 4
+ end procedure
+
+! This makes sure that an dummy with explicit shape has the upper
+! bound correctly set in the module procedure.
+
+ module procedure bar3
+ if (lbound(arg, 1) .ne. 1) stop 5
+ if (arg(3) .ne. 'hijk') stop 6 ! { dg-warning "is out of bounds" }
+ end procedure
+
+end module
+
+ use foobar
+ character(4) :: list(3) = ['abcd', 'efgh' , 'hijk']
+ type(foo) :: f
+ call f%bar1(list)
+ call f%bar2(list)
+ call f%bar3(list)
+end
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2020-12-28 14:55 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2020-12-28 14:55 [gcc r10-9180] This patch fixes PR96320. See the explanatory comment in the testcase Paul Thomas
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).