[Patch, fortran] PR24862 IO for arrays of derived type.

[Janne Blomqvist]

On Thu, Nov 17, 2005 at 09:26:26PM +0100, Tobias.Schlueter@Physik.Uni-Muenchen.DE wrote:
> Quoting Janne Blomqvist <jblomqvi@cc.hut.fi>:
> > my transfer_array patch that was committed about two months ago didn't
> > handle IO for arrays of derived type correctly. This patch fixes it.
> >
> > The control flow in the new version is a bit convoluted, so I'd be
> > happy to recieve suggestions on how to improve it.
> 
> WRT this hunk:
> +	  tmp = gfc_get_dtype (TREE_TYPE (se.expr));
> +	  if (((TREE_INT_CST_LOW (tmp) & GFC_DTYPE_TYPE_MASK)
> +	       >> GFC_DTYPE_TYPE_SHIFT) != GFC_DTYPE_DERIVED)
> +	    {
> +	      tmp = gfc_build_addr_expr (NULL, se.expr);
> +	      transfer_array_desc (&se, &expr->ts, tmp);
> +	      goto finish_block_label;
> +	    }
> +	  else
> +	    {
> +	      /* Cleanup the mess getting the descriptor caused.  */
> +	      expr = code->expr;
> +	      ss = gfc_walk_expr (expr);
> +	      gfc_init_se (&se, NULL);
> +	    }
> 
> You could do away with the call to gfc_get_dtype and the subsequent if by saying
> the following, mimicing the code in gfc_get_dtype:
>   if (TREE_TYPE (gfc_get_element_type (se.expr)) == RECORD_TYPE)

I can't get the patch to work with this change. The code above
compares an integer with a pointer. By looking at gfc_get_dtype and
other code I came up with

  if (TREE_CODE (gfc_get_element_type (TREE_TYPE (se.expr)))
	    == RECORD_TYPE)

That compiles without warnings but doesn't work correctly. It still
tries to use transfer_array even though that won't work with derived
types.

Attached is an updated testcase, incorporating the suggestions made by
Paul Thomas.

-- 
Janne Blomqvist
-------------- next part --------------
! { dg-do run }
! PR 24862: IO for arrays of derived type handled incorrectly.
program arrayio_derived_1
  implicit none
  type tp
     integer :: i
     character(len=1) :: c
  end type tp
  type(tp) :: Y(5)

  call inittp(Y)
  write(*,*) Y%i
  call test(Y)

  contains

  subroutine inittp(X)
    type(tp), intent(inout) :: X(:)
    X%i = 256
    x%c = "q"
  end subroutine inittp

  subroutine test(x)
    type(tp), intent(in) :: x(:)
    
    write(*,*) x%i
    write(*,*) x
    write (*, *) x(:)%i
  end subroutine test

end program arrayio_derived_1
-------------- next part --------------
A non-text attachment was scrubbed...
Name: not available
Type: application/pgp-signature
Size: 185 bytes
Desc: not available
URL: <http://gcc.gnu.org/pipermail/gcc-patches/attachments/20051117/383b9279/attachment.sig>