diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/fortran/ChangeLog | 7 | ||||
| -rw-r--r-- | gcc/fortran/trans-array.c | 31 | ||||
| -rw-r--r-- | gcc/fortran/trans-array.h | 2 | ||||
| -rw-r--r-- | gcc/fortran/trans-expr.c | 39 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 4 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.fortran-torture/execute/der_init_5.f90 | 6 | 
6 files changed, 55 insertions, 34 deletions
| diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 1b39762b967..813e7c0d400 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +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. +  2004-07-10  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>  	PR fortran/16336 diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 731fb193099..62ecafe767d 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -288,27 +288,26 @@ gfc_conv_descriptor_ubound (tree desc, tree dim)  } -/* Generate an initializer for a static pointer or allocatable array.  */ +/* Build an null array descriptor constructor.  */ -void -gfc_trans_static_array_pointer (gfc_symbol * sym) +tree +gfc_build_null_descriptor (tree type)  { -  tree tmp;    tree field; -  tree type; +  tree tmp; -  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); +  /* 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; -  DECL_INITIAL (sym->backend_decl) = tmp; +  /* All other fields are ignored.  */ + +  return tmp;  } @@ -422,6 +421,20 @@ gfc_add_ss_to_loop (gfc_loopinfo * loop, gfc_ss * head)  } +/* 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.  */ diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h index a78c04f4b04..ee7db9beaee 100644 --- a/gcc/fortran/trans-array.h +++ b/gcc/fortran/trans-array.h @@ -73,6 +73,8 @@ void gfc_trans_scalarized_loop_boundary (gfc_loopinfo *, stmtblock_t *);  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 *); diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 5c62234660f..a8412bdcf28 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -1379,7 +1379,6 @@ gfc_conv_structure (gfc_se * se, gfc_expr * expr, int init)    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); @@ -1397,32 +1396,28 @@ gfc_conv_structure (gfc_se * se, gfc_expr * expr, int init)        /* Evaluate the expression for this component.  */        if (init)  	{ -	  if (!cm->pointer) +	  if (cm->dimension)  	    { -	      /* 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); +	      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 +	  else if (cm->pointer)  	    { -	      /* 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); +	      /* 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  	{ diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 7ae23fd8b28..497eca53383 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2004-07-10  Paul Brook  <paul@codesourcery.com> + +	* gfortran.fortran-torture/execute/der_init_5.f90: Enable more tests. +  2004-07-10  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>  	PR fortran/15969 diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/der_init_5.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/der_init_5.f90 index 22c0c33ba2f..c81d9260e55 100644 --- a/gcc/testsuite/gfortran.fortran-torture/execute/der_init_5.f90 +++ b/gcc/testsuite/gfortran.fortran-torture/execute/der_init_5.f90 @@ -5,12 +5,12 @@ program der_init_5    type t       type(t), pointer :: a => NULL()       real, pointer :: b => NULL() -!     character, pointer :: c => NULL() -!     integer, pointer, dimension(:) :: d => 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() +  if (associated(p%d)) call abort()  end | 

