[Patch, fortran] PRs 46691 and 99819: Assumed and explicit size class arrays

[Patch, fortran] PRs 46691 and 99819: Assumed and explicit size class arrays

[Paul Richard Thomas]

[-- Attachment #1: Type: text/plain, Size: 1483 bytes --]

Hi All,

Although I had undertaken to concentrate on PDTs, PR99819 so intrigued me
that I became locked into it :-( After extensive, fruitless rummaging
through decl.c and trans-decl.c, I realised that the problem was far
simpler than it seemed and that it lay in class.c. After that PR was fixed,
PR46691 was a trivial follow up.

The comments in the patch explain the fixes. I left a TODO for the extent
checking of assumed size class arrays. I will try to fix it before pushing.

Regtested on FC33/x86_64 and checked against the 'other brand'. OK for
12-branch and, perhaps, 11-branch?

Regards

Paul

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): 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_6.f90: New test.

[-- Attachment #2: submit.diff --]
[-- Type: text/x-patch, Size: 4237 bytes --]

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 e99980fd223..6d38ea78273 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -6524,7 +6524,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);
@@ -6626,7 +6633,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 213f32b0a67..5f5479561c2 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -6420,6 +6420,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

[-- Attachment #3: class_dummy_7.f90 --]
[-- Type: text/x-fortran, Size: 1424 bytes --]

! { 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

[-- Attachment #4: class_dummy_6.f90 --]
[-- Type: text/x-fortran, Size: 1558 bytes --]

! { 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

Re: [Patch, fortran] PRs 46691 and 99819: Assumed and explicit size class arrays

[Paul Richard Thomas]

Hi All,

Please find below a corrected ChangeLog.

Sorry that I didn't get it right first go.

Paul

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.


On Thu, 6 May 2021 at 07:57, Paul Richard Thomas <
paul.richard.thomas@gmail.com> wrote:

> Hi All,
>
> Although I had undertaken to concentrate on PDTs, PR99819 so intrigued me
> that I became locked into it :-( After extensive, fruitless rummaging
> through decl.c and trans-decl.c, I realised that the problem was far
> simpler than it seemed and that it lay in class.c. After that PR was fixed,
> PR46691 was a trivial follow up.
>
> The comments in the patch explain the fixes. I left a TODO for the extent
> checking of assumed size class arrays. I will try to fix it before pushing.
>
> Regtested on FC33/x86_64 and checked against the 'other brand'. OK for
> 12-branch and, perhaps, 11-branch?
>
> Regards
>
> Paul
>
> 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): 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_6.f90: New test.
>
>

-- 
"If you can't explain it simply, you don't understand it well enough" -
Albert Einstein

Re: [Patch, fortran] PRs 46691 and 99819: Assumed and explicit size class arrays

[Andre Vehreschild]

Hi Paul,

this and the Changelog LGTM at least for 12. Give it a consolidation time before
applying to 11. Having had some issues in the vicinity of the code you addressed
I am quite happy to see how easy the fix looks.

Any chances you can take a look at
     https://gcc.gnu.org/pipermail/fortran/2021-April/055990.html
?

Regards,
	Andre

On Thu, 6 May 2021 07:57:05 +0100
Paul Richard Thomas via Fortran <fortran@gcc.gnu.org> wrote:

> Hi All,
>
> Although I had undertaken to concentrate on PDTs, PR99819 so intrigued me
> that I became locked into it :-( After extensive, fruitless rummaging
> through decl.c and trans-decl.c, I realised that the problem was far
> simpler than it seemed and that it lay in class.c. After that PR was fixed,
> PR46691 was a trivial follow up.
>
> The comments in the patch explain the fixes. I left a TODO for the extent
> checking of assumed size class arrays. I will try to fix it before pushing.
>
> Regtested on FC33/x86_64 and checked against the 'other brand'. OK for
> 12-branch and, perhaps, 11-branch?
>
> Regards
>
> Paul
>
> 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): 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_6.f90: New test.


--
Andre Vehreschild * Email: vehre ad gmx dot de