public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc/devel/omp/gcc-11] Fortran: Assumed and explicit size class arrays [PR46691/99819].
@ 2021-08-20 3:05 Sandra Loosemore
0 siblings, 0 replies; only message in thread
From: Sandra Loosemore @ 2021-08-20 3:05 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:4ec35530502cdbf18f3ff13202c4f63b64395f42
commit 4ec35530502cdbf18f3ff13202c4f63b64395f42
Author: Paul Thomas <pault@gcc.gnu.org>
Date: Wed Aug 11 17:54:14 2021 -0700
Fortran: Assumed and explicit size class arrays [PR46691/99819].
2021-05-06 Paul Thomas <pault@gcc.gnu.org>
gcc/fortran/ChangeLog
PR fortran/46691
PR fortran/99819
* class.c (gfc_build_class_symbol): Remove the error that
disables assumed size class arrays. Class array types that are
not deferred shape or assumed rank are given a unique name and
placed in the procedure namespace.
* trans-array.c (gfc_trans_g77_array): Obtain the data pointer
for class arrays.
(gfc_trans_dummy_array_bias): Suppress the runtime error for
extent violations in explicit shape class arrays because it
always fails.
* trans-expr.c (gfc_conv_procedure_call): Handle assumed size
class actual arguments passed to non-descriptor formal args by
using the data pointer, stored as the symbol's backend decl.
gcc/testsuite/ChangeLog
PR fortran/46691
PR fortran/99819
* gfortran.dg/class_dummy_6.f90: New test.
* gfortran.dg/class_dummy_7.f90: New test.
(cherry picked from commit a2c593009fef1564dbef2237ee71e9fd08f5361e)
Diff:
---
gcc/fortran/ChangeLog.omp | 20 +++++++++
gcc/fortran/class.c | 33 +++++++++++----
gcc/fortran/trans-array.c | 12 +++++-
gcc/fortran/trans-expr.c | 9 ++++
gcc/testsuite/ChangeLog.omp | 10 +++++
gcc/testsuite/gfortran.dg/class_dummy_6.f90 | 65 +++++++++++++++++++++++++++++
gcc/testsuite/gfortran.dg/class_dummy_7.f90 | 60 ++++++++++++++++++++++++++
7 files changed, 199 insertions(+), 10 deletions(-)
diff --git a/gcc/fortran/ChangeLog.omp b/gcc/fortran/ChangeLog.omp
index 7db917878d9..88c3c52c32a 100644
--- a/gcc/fortran/ChangeLog.omp
+++ b/gcc/fortran/ChangeLog.omp
@@ -1,3 +1,23 @@
+2021-08-11 Sandra Loosemore <sandra@codesourcery.com>
+
+ Backported from master:
+ 2021-05-06 Paul Thomas <pault@gcc.gnu.org>
+
+ PR fortran/46691
+ PR fortran/99819
+ * class.c (gfc_build_class_symbol): Remove the error that
+ disables assumed size class arrays. Class array types that are
+ not deferred shape or assumed rank are given a unique name and
+ placed in the procedure namespace.
+ * trans-array.c (gfc_trans_g77_array): Obtain the data pointer
+ for class arrays.
+ (gfc_trans_dummy_array_bias): Suppress the runtime error for
+ extent violations in explicit shape class arrays because it
+ always fails.
+ * trans-expr.c (gfc_conv_procedure_call): Handle assumed size
+ class actual arguments passed to non-descriptor formal args by
+ using the data pointer, stored as the symbol's backend decl.
+
2021-08-18 Tobias Burnus <tobias@codesourcery.com>
Backported from master:
diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c
index 89353218417..93118ad3455 100644
--- a/gcc/fortran/class.c
+++ b/gcc/fortran/class.c
@@ -630,6 +630,7 @@ gfc_get_len_component (gfc_expr *e, int k)
component '_vptr' which determines the dynamic type. When this CLASS
entity is unlimited polymorphic, then also add a component '_len' to
store the length of string when that is stored in it. */
+static int ctr = 0;
bool
gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr,
@@ -645,13 +646,6 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr,
gcc_assert (as);
- if (*as && (*as)->type == AS_ASSUMED_SIZE)
- {
- gfc_error ("Assumed size polymorphic objects or components, such "
- "as that at %C, have not yet been implemented");
- return false;
- }
-
if (attr->class_ok)
/* Class container has already been built. */
return true;
@@ -693,7 +687,30 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr,
else
ns = ts->u.derived->ns;
- gfc_find_symbol (name, ns, 0, &fclass);
+ /* Although this might seem to be counterintuitive, we can build separate
+ class types with different array specs because the TKR interface checks
+ work on the declared type. All array type other than deferred shape or
+ assumed rank are added to the function namespace to ensure that they
+ are properly distinguished. */
+ if (attr->dummy && !attr->codimension && (*as)
+ && !((*as)->type == AS_DEFERRED || (*as)->type == AS_ASSUMED_RANK))
+ {
+ char *sname;
+ ns = gfc_current_ns;
+ gfc_find_symbol (name, ns, 0, &fclass);
+ /* If a local class type with this name already exists, update the
+ name with an index. */
+ if (fclass)
+ {
+ fclass = NULL;
+ sname = xasprintf ("%s_%d", name, ++ctr);
+ free (name);
+ name = sname;
+ }
+ }
+ else
+ gfc_find_symbol (name, ns, 0, &fclass);
+
if (fclass == NULL)
{
gfc_symtree *st;
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index e17f5b684c4..958e6ef4272 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -6529,7 +6529,14 @@ gfc_trans_g77_array (gfc_symbol * sym, gfc_wrapped_block * block)
/* Set the pointer itself if we aren't using the parameter directly. */
if (TREE_CODE (parm) != PARM_DECL)
{
- tmp = convert (TREE_TYPE (parm), GFC_DECL_SAVED_DESCRIPTOR (parm));
+ tmp = GFC_DECL_SAVED_DESCRIPTOR (parm);
+ if (sym->ts.type == BT_CLASS)
+ {
+ tmp = build_fold_indirect_ref_loc (input_location, tmp);
+ tmp = gfc_class_data_get (tmp);
+ tmp = gfc_conv_descriptor_data_get (tmp);
+ }
+ tmp = convert (TREE_TYPE (parm), tmp);
gfc_add_modify (&init, parm, tmp);
}
stmt = gfc_finish_block (&init);
@@ -6631,7 +6638,8 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc,
&& VAR_P (sym->ts.u.cl->backend_decl))
gfc_conv_string_length (sym->ts.u.cl, NULL, &init);
- checkparm = (as->type == AS_EXPLICIT
+ /* TODO: Fix the exclusion of class arrays from extent checking. */
+ checkparm = (as->type == AS_EXPLICIT && !is_classarray
&& (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS));
no_repack = !(GFC_DECL_PACKED_ARRAY (tmpdesc)
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 5b446f1c733..10e22122df8 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -6423,6 +6423,15 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
fsym ? fsym->attr.intent : INTENT_INOUT,
fsym && fsym->attr.pointer);
+ else if (e->ts.type == BT_CLASS && CLASS_DATA (e)->as
+ && CLASS_DATA (e)->as->type == AS_ASSUMED_SIZE
+ && nodesc_arg && fsym->ts.type == BT_DERIVED)
+ /* An assumed size class actual argument being passed to
+ a 'no descriptor' formal argument just requires the
+ data pointer to be passed. For class dummy arguments
+ this is stored in the symbol backend decl.. */
+ parmse.expr = e->symtree->n.sym->backend_decl;
+
else if (gfc_is_class_array_ref (e, NULL)
&& fsym && fsym->ts.type == BT_DERIVED)
/* The actual argument is a component reference to an
diff --git a/gcc/testsuite/ChangeLog.omp b/gcc/testsuite/ChangeLog.omp
index c9cef896b61..a31536276a2 100644
--- a/gcc/testsuite/ChangeLog.omp
+++ b/gcc/testsuite/ChangeLog.omp
@@ -1,3 +1,13 @@
+2021-08-11 Sandra Loosemore <sandra@codesourcery.com>
+
+ Backported from master:
+ 2021-05-06 Paul Thomas <pault@gcc.gnu.org>
+
+ PR fortran/46691
+ PR fortran/99819
+ * gfortran.dg/class_dummy_6.f90: New test.
+ * gfortran.dg/class_dummy_7.f90: New test.
+
2021-08-19 Tobias Burnus <tobias@codesourcery.com>
Backported from master:
diff --git a/gcc/testsuite/gfortran.dg/class_dummy_6.f90 b/gcc/testsuite/gfortran.dg/class_dummy_6.f90
new file mode 100644
index 00000000000..79f6e86daa7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_dummy_6.f90
@@ -0,0 +1,65 @@
+! { dg-do run }
+!
+! Test the fix for PR99819 - explicit shape class arrays in different
+! procedures caused an ICE.
+!
+! Contributed by Gerhard Steinmetz <gscfq@t-online.de>
+!
+program p
+ type t
+ integer :: i
+ end type
+ class(t), allocatable :: dum1(:), dum2(:), dum3(:,:)
+
+ allocate (t :: dum1(3), dum2(10), dum3(2,5))
+ dum2%i = [1,2,3,4,5,6,7,8,9,10]
+ dum3%i = reshape ([1,2,3,4,5,6,7,8,9,10],[2,5])
+
+! Somewhat elaborated versions of the PR procedures.
+ if (f (dum1, dum2, dum3) .ne. 10) stop 1
+ if (g (dum1) .ne. 3) stop 2
+
+! Test the original versions of the procedures.
+ if (f_original (dum1, dum2) .ne. 3) stop 3
+ if (g_original (dum2) .ne. 10) stop 4
+
+contains
+ integer function f(x, y, z)
+ class(t) :: x(:)
+ class(t) :: y(size( x))
+ class(t) :: z(2,*)
+ if (size (y) .ne. 3) stop 5
+ if (size (z) .ne. 0) stop 6
+ select type (y)
+ type is (t)
+ f = 1
+ if (any (y%i .ne. [1,2,3])) stop 7
+ class default
+ f = 0
+ end select
+ select type (z)
+ type is (t)
+ f = f*10
+ if (any (z(1,1:4)%i .ne. [1,3,5,7])) stop 8
+ class default
+ f = 0
+ end select
+ end
+ integer function g(z)
+ class(t) :: z(:)
+ type(t) :: u(size(z))
+ g = size (u)
+ end
+
+ integer function f_original(x, y)
+ class(t) :: x(:)
+ class(*) :: y(size (x))
+ f_original = size (y)
+ end
+
+ integer function g_original(z)
+ class(*) :: z(:)
+ type(t) :: u(size(z))
+ g_original = size (u)
+ end
+end
diff --git a/gcc/testsuite/gfortran.dg/class_dummy_7.f90 b/gcc/testsuite/gfortran.dg/class_dummy_7.f90
new file mode 100644
index 00000000000..913426804f3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_dummy_7.f90
@@ -0,0 +1,60 @@
+! { dg-do run }
+!
+! Test the fix for PR46691 - enable class assumed size arrays
+!
+! Reported by Tobias Burnus <burnus@gcc.gnu.org>
+! from http://j3-fortran.org/pipermail/j3/2010-December/004084.html
+! submitted by Robert Corbett.
+!
+ MODULE TYPES
+ PRIVATE
+ PUBLIC REC, REC2
+
+ TYPE REC
+ INTEGER A
+ END TYPE
+
+ TYPE, EXTENDS(REC) :: REC2
+ INTEGER B
+ END TYPE
+ END
+
+ SUBROUTINE SUB1(A, N)
+ USE TYPES
+ CLASS(REC), INTENT(IN) :: A(*)
+ INTERFACE
+ SUBROUTINE SUB2(A, N, IARRAY)
+ USE TYPES
+ TYPE(REC) A(*)
+ INTEGER :: N, IARRAY(N)
+ END
+ END INTERFACE
+
+ CALL SUB2(A, N,[1,2,2,3,3,4,4,5,5,6])
+ select type (B => A(1:N))
+ type is (REC2)
+ call SUB2(B%REC,N,[1,2,3,4,5,6,7,8,9,10])
+ end select
+
+ END
+
+ SUBROUTINE SUB2(A, N, IARRAY)
+ USE TYPES
+ TYPE(REC) A(*)
+ INTEGER :: N, IARRAY(N)
+ if (any (A(:N)%A .ne. IARRAY(:N))) stop 1
+ END
+
+ PROGRAM MAIN
+ USE TYPES
+ CLASS(REC), ALLOCATABLE :: A(:)
+ INTERFACE
+ SUBROUTINE SUB1(A, N)
+ USE TYPES
+ CLASS(REC), INTENT(IN) :: A(*)
+ END SUBROUTINE
+ END INTERFACE
+
+ A = [ (REC2(I, I+1), I = 1, 10) ]
+ CALL SUB1(A, 10)
+ END
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2021-08-20 3:05 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-08-20 3:05 [gcc/devel/omp/gcc-11] Fortran: Assumed and explicit size class arrays [PR46691/99819] Sandra Loosemore
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).