[gfortran] Array pointers in derived types.

[Paul Brook <paul at codesourcery dot com>]

The following patch implements initialization of array pointers in derived 
types, and enables the testcase. I also restructured the logic slightly.

Tested on i686-linux. Applied to mainline.

Paul

2004-07-10  Paul Brook  <paul@codesourcery.com>

	* trans-array.c (gfc_build_null_descriptor): New function.
	(gfc_trans_static_array_pointer): Use it.
	* trans-array.h (gfc_build_null_descriptor): Add prototype.
	* trans-expr.c (gfc_conv_structure): Handle array pointers.
testsuite/
	* gfortran.fortran-torture/execute/der_init_5.f90: Enable more tests.

Index: fortran/trans-array.c
===================================================================
RCS file: /var/cvsroot/gcc-cvs/gcc/gcc/fortran/trans-array.c,v
retrieving revision 1.8
diff -c -p -r1.8 trans-array.c
*** fortran/trans-array.c	29 Jun 2004 22:01:34 -0000	1.8
--- fortran/trans-array.c	10 Jul 2004 22:15:33 -0000
*************** gfc_conv_descriptor_ubound (tree desc, t
*** 288,314 ****
  }
  
  
! /* Generate an initializer for a static pointer or allocatable array.  */
  
! void
! gfc_trans_static_array_pointer (gfc_symbol * sym)
  {
-   tree tmp;
    tree field;
!   tree type;
  
-   assert (TREE_STATIC (sym->backend_decl));
-   /* Just zero the data member.  */
-   type = TREE_TYPE (sym->backend_decl);
    assert (GFC_DESCRIPTOR_TYPE_P (type));
    assert (DATA_FIELD == 0);
    field = TYPE_FIELDS (type);
  
    tmp = tree_cons (field, null_pointer_node, NULL_TREE);
    tmp = build1 (CONSTRUCTOR, type, tmp);
    TREE_CONSTANT (tmp) = 1;
    TREE_INVARIANT (tmp) = 1;
!   DECL_INITIAL (sym->backend_decl) = tmp;
  }
  
  
--- 288,313 ----
  }
  
  
! /* Build an null array descriptor constructor.  */
  
! tree
! gfc_build_null_descriptor (tree type)
  {
    tree field;
!   tree tmp;
  
    assert (GFC_DESCRIPTOR_TYPE_P (type));
    assert (DATA_FIELD == 0);
    field = TYPE_FIELDS (type);
  
+   /* Set a NULL data pointer.  */
    tmp = tree_cons (field, null_pointer_node, NULL_TREE);
    tmp = build1 (CONSTRUCTOR, type, tmp);
    TREE_CONSTANT (tmp) = 1;
    TREE_INVARIANT (tmp) = 1;
!   /* All other fields are ignored.  */
! 
!   return tmp;
  }
  
  
*************** gfc_add_ss_to_loop (gfc_loopinfo * loop,
*** 422,427 ****
--- 421,440 ----
  }
  
  
+ /* Generate an initializer for a static pointer or allocatable array.  */
+ 
+ void
+ gfc_trans_static_array_pointer (gfc_symbol * sym)
+ {
+   tree type;
+ 
+   assert (TREE_STATIC (sym->backend_decl));
+   /* Just zero the data member.  */
+   type = TREE_TYPE (sym->backend_decl);
+   DECL_INITIAL (sym->backend_decl) =gfc_build_null_descriptor (type);
+ }
+ 
+ 
  /* Generate code to allocate an array temporary, or create a variable to
     hold the data.  */
  
Index: fortran/trans-array.h
===================================================================
RCS file: /var/cvsroot/gcc-cvs/gcc/gcc/fortran/trans-array.h,v
retrieving revision 1.3
diff -c -p -r1.3 trans-array.h
*** fortran/trans-array.h	14 May 2004 13:00:04 -0000	1.3
--- fortran/trans-array.h	10 Jul 2004 22:15:40 -0000
*************** void gfc_trans_scalarized_loop_boundary 
*** 73,78 ****
--- 73,80 ----
  void gfc_conv_loop_setup (gfc_loopinfo *);
  /* Resolve array assignment dependencies.  */
  void gfc_conv_resolve_dependencies (gfc_loopinfo *, gfc_ss *, gfc_ss *);
+ /* Build an null array descriptor constructor.  */
+ tree gfc_build_null_descriptor (tree);
  
  /* Get a single array element.  */
  void gfc_conv_array_ref (gfc_se *, gfc_array_ref *);
Index: fortran/trans-expr.c
===================================================================
RCS file: /var/cvsroot/gcc-cvs/gcc/gcc/fortran/trans-expr.c,v
retrieving revision 1.13
diff -c -p -r1.13 trans-expr.c
*** fortran/trans-expr.c	10 Jul 2004 17:30:40 -0000	1.13
--- fortran/trans-expr.c	10 Jul 2004 22:20:24 -0000
*************** gfc_conv_structure (gfc_se * se, gfc_exp
*** 1379,1385 ****
    tree val;
    gfc_se cse;
    tree type;
-   tree arraytype;
  
    assert (expr->expr_type == EXPR_STRUCTURE || expr->expr_type == 
EXPR_NULL);
    type = gfc_typenode_for_spec (&expr->ts);
--- 1379,1384 ----
*************** gfc_conv_structure (gfc_se * se, gfc_exp
*** 1397,1428 ****
        /* Evaluate the expression for this component.  */
        if (init)
  	{
! 	  if (!cm->pointer)
  	    {
! 	      /* Initializing a non-pointer element.  */
! 	      if (cm->dimension)
! 		{
! 		  arraytype = TREE_TYPE (cm->backend_decl);
! 		  cse.expr = gfc_conv_array_initializer (arraytype, c->expr);
! 		}
! 	      else if (cm->ts.type == BT_DERIVED)
! 		gfc_conv_structure (&cse, c->expr, 1);
! 	      else
! 		gfc_conv_expr (&cse, c->expr);
  
  	    }
! 	  else
  	    {
! 	      /* Pointer components may only be initialized to
! 		 NULL. This should have been enforced by the frontend.  */
! 	      if (cm->dimension)
! 		{
! 		  gfc_todo_error ("Initialization of pointer members");
! 		}
! 	      else
! 		cse.expr = fold_convert (TREE_TYPE (cm->backend_decl), 
! 					 null_pointer_node);
  	    }
  	}
        else
  	{
--- 1396,1423 ----
        /* Evaluate the expression for this component.  */
        if (init)
  	{
! 	  if (cm->dimension)
  	    {
! 	      tree arraytype;
! 	      arraytype = TREE_TYPE (cm->backend_decl);
  
+ 	      /* Arrays need special handling.  */
+ 	      if (cm->pointer)
+ 		cse.expr = gfc_build_null_descriptor (arraytype);
+ 	      else
+ 		cse.expr = gfc_conv_array_initializer (arraytype, c->expr);
  	    }
! 	  else if (cm->pointer)
  	    {
! 	      /* Pointer components may only be initialized to NULL.  */
! 	      assert (c->expr->expr_type == EXPR_NULL);
! 	      cse.expr = fold_convert (TREE_TYPE (cm->backend_decl), 
! 				       null_pointer_node);
  	    }
+ 	  else if (cm->ts.type == BT_DERIVED)
+ 	    gfc_conv_structure (&cse, c->expr, 1);
+ 	  else
+ 	    gfc_conv_expr (&cse, c->expr);
  	}
        else
  	{
Index: testsuite/gfortran.fortran-torture/execute/der_init_5.f90
===================================================================
RCS 
file: /var/cvsroot/gcc-cvs/gcc/gcc/testsuite/gfortran.fortran-torture/execute/der_init_5.f90,v
retrieving revision 1.1
diff -c -p -r1.1 der_init_5.f90
*** testsuite/gfortran.fortran-torture/execute/der_init_5.f90	10 Jul 2004 
17:54:35 -0000	1.1
--- testsuite/gfortran.fortran-torture/execute/der_init_5.f90	10 Jul 2004 
22:32:13 -0000
*************** program der_init_5
*** 5,16 ****
    type t
       type(t), pointer :: a => NULL()
       real, pointer :: b => NULL()
! !     character, pointer :: c => NULL()
! !     integer, pointer, dimension(:) :: d => NULL()
    end type t
    type (t) :: p
    if (associated(p%a)) call abort()
    if (associated(p%b)) call abort()
  !  if (associated(p%c)) call abort()
! !  if (associated(p%d)) call abort()
  end
--- 5,16 ----
    type t
       type(t), pointer :: a => NULL()
       real, pointer :: b => NULL()
!      character, pointer :: c => NULL()
!      integer, pointer, dimension(:) :: d => NULL()
    end type t
    type (t) :: p
    if (associated(p%a)) call abort()
    if (associated(p%b)) call abort()
  !  if (associated(p%c)) call abort()
!   if (associated(p%d)) call abort()
  end