diff mbox

[fortran] Fix temporary allocation for class assignment.

Message ID CAGkQGiKtWAJ=0yB_CjO_o4tO8PWqnbpbwdjg09B+hPwkabi1tQ@mail.gmail.com
State New
Headers show

Commit Message

Paul Richard Thomas Jan. 14, 2012, 9:52 p.m. UTC 
Dear All,

As previously advertised, the attached patch fixes the problem with
using an index array in the final assignment in subroutine qsort in
class_array_3.f03.  The failure occurred because the temporary array
was assigned zero size, since the declared type is abstract.  More
generally, even if the temporary is not zero size, the dynamic type
will always be larger than the declared type.

I have used what might appear to be a rather ad-hoc mechanism; set the
element type to null in the call to gfc_trans_create_temp_array and
pass the class reference indirectly through 'initial'.  Since, for
this application, we always want the initial value to be that of the
left hand side of the assignment, all is well. I have reviewed all the
other users of gfc_trans_create_temp_array and cannot see any issues
at present.  When F2008 intrinsic assignment of classes is introduced,
some care will have to be taken in gfc_trans_assignment_1, between the
call to      gfc_conv_resolve_dependencies and that to
gfc_conv_loop_setup, to ensure that the temporary, if it exists, is
initialized correctly.  Thus, all in all, I do not think that it is in
fact ad-hoc and is rather easily extended to future needs.

Please reassure me that class array constructors do not, cannot and
will never occur!  :-)

When TRANSFER is implemented for class objects, there will likely be a
similar issue with gfc_trans_create_temp_array.

Bootstrapped and regtested on Fc9/x86_64 - OK for trunk?

Cheers

Paul

2012-01-14  Paul Thomas  <pault@gcc.gnu.org>

	* trans-array.c (gfc_trans_create_temp_array): In the case of a
	class array temporary, detect a null 'eltype' on entry and use
	'initial' to provde the class reference and so, through the
	vtable, the element size for the dynamic type.
	* trans-stmt.c (gfc_conv_elemental_dependencies): For class
	expressions, set 'eltype' to null and pass the values via the
	'initial' expression.

2012-01-14  Paul Thomas  <pault@gcc.gnu.org>

	* gfortran.dg/class_array_3.f03: Remove the explicit loop in
	subroutine 'qsort' and use index array to assign the result.

Comments

Tobias Burnus Jan. 15, 2012, 11:47 a.m. UTC | #1 
Dear Paul,

Paul Richard Thomas wrote:
> Please reassure me that class array constructors do not, cannot and
> will never occur!:-)

Do you mean something like the following:

!------------------------------------
type t
   integer :: i = 5
end type t
type, extends(t) :: t2
   integer :: j = 6
end type t2

class(t), allocatable :: a(:), b(:), c(:)
allocate(t :: a(3))
allocate(t :: b(5))
allocate(t :: c(8))
c = [ a, b ]
select type(c)
   type is(t)
     print '(*(i2))', c%i
   type is(t2)
     print '(*(i2))', c%i
     print '(*(i2))', c%j
end select
end
!------------------------------------

That's accepted by the Cray compiler (7.1.4.111) and produces:
  5 5 5 5 5 5 5 5
Though, if one changes "t ::" to "t2 ::", the result is the slightly 
surprising
  5 5 6 6 5 5 5 5
  6 5 5 5 6 6 6 6

I think that code is valid Fortran 2003/2008. But to cheer you up: 
Unlimited polymorphic expressions are not allowed in array constructors 
(cf. C4107).

> Bootstrapped and regtested on Fc9/x86_64 - OK for trunk?

OK. Thanks for the patch.

> *************** gfc_trans_create_temp_array (stmtblock_t
> +   /* This signals a class array for which we need the size of the
> +      dynamic type.  Generate an eltype and then the class expression.  */
> +   if (eltype == NULL_TREE&&  initial)

Can you add a small note in the comment before the function which 
mentions that eltype == NULL_TREE is handed in a special way?

Tobias
Paul Richard Thomas Jan. 15, 2012, 10:41 p.m. UTC | #2 
Dear Tobias,

The following example that you provided:

> Do you mean something like the following:
>
> !------------------------------------
> type t
>  integer :: i = 5
> end type t
> type, extends(t) :: t2
>  integer :: j = 6
> end type t2
>
> class(t), allocatable :: a(:), b(:), c(:)
> allocate(t :: a(3))
> allocate(t :: b(5))
> allocate(t :: c(8))
> c = [ a, b ]
> select type(c)
>  type is(t)
>    print '(*(i2))', c%i
>  type is(t2)
>    print '(*(i2))', c%i
>    print '(*(i2))', c%j
> end select
> end
> !------------------------------------

Is exactly the abomination that I did not want to exist!  What happens
if 'a' and 'b' have different dynamic types?
>
> That's accepted by the Cray compiler (7.1.4.111) and produces:
>  5 5 5 5 5 5 5 5
> Though, if one changes "t ::" to "t2 ::", the result is the slightly
> surprising
>  5 5 6 6 5 5 5 5
>  6 5 5 5 6 6 6 6
>
> I think that code is valid Fortran 2003/2008. But to cheer you up: Unlimited
> polymorphic expressions are not allowed in array constructors (cf. C4107).

Surely it cannot be valid?


> Can you add a small note in the comment before the function which mentions
> that eltype == NULL_TREE is handed in a special way?
>

No problem.

Thanks for the review.

Cheers

Paul

PS I know how to fix PR51634.... will get on to it as soon as I have a moment.
Tobias Burnus Jan. 15, 2012, 11:28 p.m. UTC | #3 
Dear Paul,

Paul Richard Thomas wrote:
>> >  c = [ a, b ]
> Is exactly the abomination that I did not want to exist!  What happens
> if 'a' and 'b' have different dynamic types?

Actually, I start to get lost in the fine prints. One finds:

"The dynamic type of an array constructor is the same as its declared type."

That means that for "[a, b]" one has as constructor type the declared 
type of each ac-value, which has to be the same. Thus, one has declared 
type of "a" equals dynamic type of "a" - and the same for "b" with "a" 
and "b" having the same type.

The question gets more interesting with:
   [ t2 :: a, b]

Here, "a" and "b" need to be of declared type "t2" or of one extension 
of it - and can have any dynamic type. But due to the "t2" only 
components which are also in "t2" matter.

See also PR 51864

>> >  That's accepted by the Cray compiler (7.1.4.111) and produces:
>> >    5 5 5 5 5 5 5 5

Which is the expected and valid result.

>> >  Though, if one changes "t ::" to "t2 ::", the result is the slightly
>> >  surprising
>> >    5 5 6 6 5 5 5 5
>> >    6 5 5 5 6 6 6 6

That code is actually invalid. Either both need to be of type "t" or one 
needs to a type spec and - for "[ t2 :: a, b]" also a different declared 
type.


>> >  I think that code is valid Fortran 2003/2008. But to cheer you up: Unlimited
>> >  polymorphic expressions are not allowed in array constructors (cf. C4107).
> Surely it cannot be valid?

"C4106 (R472) An ac-value shall not be unlimited polymorphic."

The reason is probably that class(*) is type compatible with everything 
thus this loophole had to be closed.

> PS I know how to fix PR51634.... will get on to it as soon as I have a moment.

Great!

Tobias
diff mbox

Patch

Index: gcc/fortran/trans-array.c
===================================================================
*** gcc/fortran/trans-array.c	(revision 183162)
--- gcc/fortran/trans-array.c	(working copy)
*************** gfc_trans_create_temp_array (stmtblock_t
*** 990,998 ****
--- 990,1012 ----
    tree nelem;
    tree cond;
    tree or_expr;
+   tree class_expr = NULL_TREE;
    int n, dim, tmp_dim;
    int total_dim = 0;
  
+   /* This signals a class array for which we need the size of the
+      dynamic type.  Generate an eltype and then the class expression.  */
+   if (eltype == NULL_TREE && initial)
+     {
+       if (POINTER_TYPE_P (TREE_TYPE (initial)))
+ 	class_expr = build_fold_indirect_ref_loc (input_location, initial);
+       eltype = TREE_TYPE (class_expr);
+       eltype = gfc_get_element_type (eltype);
+       /* Obtain the structure (class) expression.  */
+       class_expr = TREE_OPERAND (class_expr, 0);
+       gcc_assert (class_expr);
+     }
+ 
    memset (from, 0, sizeof (from));
    memset (to, 0, sizeof (to));
  
*************** gfc_trans_create_temp_array (stmtblock_t
*** 1133,1148 ****
    /* Get the size of the array.  */
    if (size && !callee_alloc)
      {
        /* If or_expr is true, then the extent in at least one
  	 dimension is zero and the size is set to zero.  */
        size = fold_build3_loc (input_location, COND_EXPR, gfc_array_index_type,
  			      or_expr, gfc_index_zero_node, size);
  
        nelem = size;
        size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
! 		size,
! 		fold_convert (gfc_array_index_type,
! 			      TYPE_SIZE_UNIT (gfc_get_element_type (type))));
      }
    else
      {
--- 1147,1167 ----
    /* Get the size of the array.  */
    if (size && !callee_alloc)
      {
+       tree elemsize;
        /* If or_expr is true, then the extent in at least one
  	 dimension is zero and the size is set to zero.  */
        size = fold_build3_loc (input_location, COND_EXPR, gfc_array_index_type,
  			      or_expr, gfc_index_zero_node, size);
  
        nelem = size;
+       if (class_expr == NULL_TREE)
+ 	elemsize = fold_convert (gfc_array_index_type,
+ 			TYPE_SIZE_UNIT (gfc_get_element_type (type)));
+       else
+ 	elemsize = gfc_vtable_size_get (class_expr);
+ 
        size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
! 			      size, elemsize);
      }
    else
      {
Index: gcc/fortran/trans-stmt.c
===================================================================
*** gcc/fortran/trans-stmt.c	(revision 183161)
--- gcc/fortran/trans-stmt.c	(working copy)
*************** gfc_conv_elemental_dependencies (gfc_se 
*** 282,300 ****
  		|| (fsym->ts.type ==BT_DERIVED
  		      && fsym->attr.intent == INTENT_OUT))
  	    initial = parmse.expr;
  	  else
  	    initial = NULL_TREE;
  
! 	  /* Find the type of the temporary to create; we don't use the type
! 	     of e itself as this breaks for subcomponent-references in e (where
! 	     the type of e is that of the final reference, but parmse.expr's
! 	     type corresponds to the full derived-type).  */
! 	  /* TODO: Fix this somehow so we don't need a temporary of the whole
! 	     array but instead only the components referenced.  */
! 	  temptype = TREE_TYPE (parmse.expr); /* Pointer to descriptor.  */
! 	  gcc_assert (TREE_CODE (temptype) == POINTER_TYPE);
! 	  temptype = TREE_TYPE (temptype);
! 	  temptype = gfc_get_element_type (temptype);
  
  	  /* Generate the temporary.  Cleaning up the temporary should be the
  	     very last thing done, so we add the code to a new block and add it
--- 282,312 ----
  		|| (fsym->ts.type ==BT_DERIVED
  		      && fsym->attr.intent == INTENT_OUT))
  	    initial = parmse.expr;
+ 	  /* For class expressions, we always initialize with the copy of
+ 	     the values.  */
+ 	  else if (e->ts.type == BT_CLASS)
+ 	    initial = parmse.expr;
  	  else
  	    initial = NULL_TREE;
  
! 	  if (e->ts.type != BT_CLASS)
! 	    {
! 	     /* Find the type of the temporary to create; we don't use the type
! 		of e itself as this breaks for subcomponent-references in e
! 		(where the type of e is that of the final reference, but
! 		parmse.expr's type corresponds to the full derived-type).  */
! 	     /* TODO: Fix this somehow so we don't need a temporary of the whole
! 		array but instead only the components referenced.  */
! 	      temptype = TREE_TYPE (parmse.expr); /* Pointer to descriptor.  */
! 	      gcc_assert (TREE_CODE (temptype) == POINTER_TYPE);
! 	      temptype = TREE_TYPE (temptype);
! 	      temptype = gfc_get_element_type (temptype);
! 	    }
! 
! 	  else
! 	    /* For class arrays signal that the size of the dynamic type has to
! 	       be obtained from the vtable, using the 'initial' expression.  */
! 	    temptype = NULL_TREE;
  
  	  /* Generate the temporary.  Cleaning up the temporary should be the
  	     very last thing done, so we add the code to a new block and add it
*************** gfc_conv_elemental_dependencies (gfc_se 
*** 312,320 ****
  	  /* Update other ss' delta.  */
  	  gfc_set_delta (loopse->loop);
  
! 	  /* Copy the result back using unpack.  */
! 	  tmp = build_call_expr_loc (input_location,
! 				 gfor_fndecl_in_unpack, 2, parmse.expr, data);
  	  gfc_add_expr_to_block (&se->post, tmp);
  
  	  /* parmse.pre is already added above.  */
--- 324,343 ----
  	  /* Update other ss' delta.  */
  	  gfc_set_delta (loopse->loop);
  
! 	  /* Copy the result back using unpack.....  */
! 	  if (e->ts.type != BT_CLASS)
! 	    tmp = build_call_expr_loc (input_location,
! 			gfor_fndecl_in_unpack, 2, parmse.expr, data);
! 	  else
! 	    {
! 	      /* ... except for class results where the copy is
! 		 unconditional.  */
! 	      tmp = build_fold_indirect_ref_loc (input_location, parmse.expr);
! 	      tmp = gfc_conv_descriptor_data_get (tmp);
! 	      tmp = build_call_expr_loc (input_location,
! 					 builtin_decl_explicit (BUILT_IN_MEMCPY),
! 					 3, tmp, data, size);
! 	    }
  	  gfc_add_expr_to_block (&se->post, tmp);
  
  	  /* parmse.pre is already added above.  */
Index: gcc/testsuite/gfortran.dg/class_array_3.f03
===================================================================
*** gcc/testsuite/gfortran.dg/class_array_3.f03	(revision 183161)
--- gcc/testsuite/gfortran.dg/class_array_3.f03	(working copy)
*************** contains
*** 45,54 ****
     allocate (tmp(size (a, 1)), source = a)
     index_array = [(i, i = 1, size (a, 1))]
     call internal_qsort (tmp, index_array)   ! Do not move class elements around until end
!    do i = 1, size (a, 1)                    ! Since they can be of arbitrary size.
!      a(i) = tmp(index_array(i))             ! Vector index array would be neater
!    end do
! !    a = tmp(index_array)                    ! Like this - TODO: fixme
   end subroutine qsort
  
   recursive subroutine internal_qsort (x, iarray)
--- 45,51 ----
     allocate (tmp(size (a, 1)), source = a)
     index_array = [(i, i = 1, size (a, 1))]
     call internal_qsort (tmp, index_array)   ! Do not move class elements around until end
!    a = tmp(index_array)
   end subroutine qsort
  
   recursive subroutine internal_qsort (x, iarray)