This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[patch,fortran]PR25057 default initialization and DATA statement conflict


The attached patch fixes this bug by providing an appropriate error message. This is related to pr24978, but needs to be handled a little differently to give a better error message. This is round one of probably several patches to catch these invalid cases.

Regression tested on x86-64-linux. OK for trunk?

Regards,

Jerry


2006-12-10 Jerry DeLisle <jvdelisle@gcc.gnu.org>


	PR fortran/25057
	* gfortran.h (gfc_assign_data_value): Return TRY instead of void.
	* data.c (gfc_assign_data_value): Add check for already initialized.
	* resolve.c (check_data_variable): If assignment fails, return FAILURE
	to avoid repeated error messages.
Index: data.c
===================================================================
*** data.c	(revision 119608)
--- data.c	(working copy)
*************** get_array_index (gfc_array_ref * ar, mpz
*** 61,67 ****
        if ((gfc_is_constant_expr (ar->as->lower[i]) == 0)
  	  || (gfc_is_constant_expr (ar->as->upper[i]) == 0)
  	  || (gfc_is_constant_expr (e) == 0))
! 	gfc_error ("non-constant array in DATA statement %L", &ar->where);        
        mpz_set (tmp, e->value.integer);
        mpz_sub (tmp, tmp, ar->as->lower[i]->value.integer);
        mpz_mul (tmp, tmp, delta);
--- 61,67 ----
        if ((gfc_is_constant_expr (ar->as->lower[i]) == 0)
  	  || (gfc_is_constant_expr (ar->as->upper[i]) == 0)
  	  || (gfc_is_constant_expr (e) == 0))
! 	gfc_error ("non-constant array in DATA statement %L", &ar->where);
        mpz_set (tmp, e->value.integer);
        mpz_sub (tmp, tmp, ar->as->lower[i]->value.integer);
        mpz_mul (tmp, tmp, delta);
*************** create_character_intializer (gfc_expr * 
*** 229,235 ****
     LVALUE already has an initialization, we extend this, otherwise we
     create a new one.  */
  
! void
  gfc_assign_data_value (gfc_expr * lvalue, gfc_expr * rvalue, mpz_t index)
  {
    gfc_ref *ref;
--- 229,235 ----
     LVALUE already has an initialization, we extend this, otherwise we
     create a new one.  */
  
! try
  gfc_assign_data_value (gfc_expr * lvalue, gfc_expr * rvalue, mpz_t index)
  {
    gfc_ref *ref;
*************** gfc_assign_data_value (gfc_expr * lvalue
*** 282,288 ****
  	      expr->rank = ref->u.ar.as->rank;
  	    }
  	  else
! 	    gcc_assert (expr->expr_type == EXPR_ARRAY);
  
  	  if (ref->u.ar.type == AR_ELEMENT)
  	    get_array_index (&ref->u.ar, &offset);
--- 282,300 ----
  	      expr->rank = ref->u.ar.as->rank;
  	    }
  	  else
! 	    {
! 	      /* Check for a derived type which is not allowed in a 
! 		 DATA statement if it has been initialized.  */
! 	      if (expr->expr_type == EXPR_STRUCTURE)
! 		{
! 		  gfc_error ("Type variable '%s', with default initialization,"
! 			     " not allowed in DATA statement at %L",
! 			     symbol->name, &lvalue->where);
! 		  return FAILURE;
! 		}
! 
! 	      gcc_assert (expr->expr_type == EXPR_ARRAY);
! 	    }
  
  	  if (ref->u.ar.type == AR_ELEMENT)
  	    get_array_index (&ref->u.ar, &offset);
*************** gfc_assign_data_value (gfc_expr * lvalue
*** 398,403 ****
--- 410,417 ----
      symbol->value = expr;
    else
      last_con->expr = expr;
+   
+   return SUCCESS;
  }
  
  /* Similarly, but initialize REPEAT consecutive values in LVALUE the same
Index: resolve.c
===================================================================
*** resolve.c	(revision 119608)
--- resolve.c	(working copy)
*************** check_data_variable (gfc_data_variable *
*** 6259,6265 ****
  	  values.left -= 1;
  	  mpz_sub_ui (size, size, 1);
  
! 	  gfc_assign_data_value (var->expr, values.vnode->expr, offset);
  
  	  if (mark == AR_FULL)
  	    mpz_add_ui (offset, offset, 1);
--- 6259,6267 ----
  	  values.left -= 1;
  	  mpz_sub_ui (size, size, 1);
  
! 	  if (gfc_assign_data_value (var->expr, values.vnode->expr, offset)
! 	      == FAILURE)
! 	    return FAILURE;
  
  	  if (mark == AR_FULL)
  	    mpz_add_ui (offset, offset, 1);
Index: gfortran.h
===================================================================
*** gfortran.h	(revision 119608)
--- gfortran.h	(working copy)
*************** extern iterator_stack *iter_stack;
*** 1704,1710 ****
  /* data.c  */
  void gfc_formalize_init_value (gfc_symbol *);
  void gfc_get_section_index (gfc_array_ref *, mpz_t *, mpz_t *);
! void gfc_assign_data_value (gfc_expr *, gfc_expr *, mpz_t);
  void gfc_assign_data_value_range (gfc_expr *, gfc_expr *, mpz_t, mpz_t);
  void gfc_advance_section (mpz_t *, gfc_array_ref *, mpz_t *);
  
--- 1704,1710 ----
  /* data.c  */
  void gfc_formalize_init_value (gfc_symbol *);
  void gfc_get_section_index (gfc_array_ref *, mpz_t *, mpz_t *);
! try gfc_assign_data_value (gfc_expr *, gfc_expr *, mpz_t);
  void gfc_assign_data_value_range (gfc_expr *, gfc_expr *, mpz_t, mpz_t);
  void gfc_advance_section (mpz_t *, gfc_array_ref *, mpz_t *);
  
! { dg-do compile }
! PR25057 Missing diagnostic for default initialization.
! Submitted by Jerry DeLisle  <jvdelisle@gcc.gnu.org>
TYPE T1
 INTEGER :: I = 7
END TYPE T1
TYPE(T1), SAVE, DIMENSION(4) :: D
DATA (D(I),I=1,2) /T1(3),T1(3)/ ! { dg-error "not allowed in DATA statement" }
END

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]