Re: [PATCH,fortran] Fix PR 31244

[Steve Kargl <sgk at troutmask dot apl dot washington dot edu>]

On Fri, Oct 05, 2007 at 04:41:07PM -0700, Steve Kargl wrote:
> On Fri, Oct 05, 2007 at 11:51:06PM +0100, FX Coudert wrote:
> > >-	  signed int tmp;
> > >-	  msg = gfc_extract_int (expr, &tmp);
> > >+	  if (expr->ts.type == BT_INTEGER)
> > >+	    mpz_set (tail->repeat, expr->value.integer);
> > > 	  gfc_free_expr (expr);
> > 
> > I think, to be consistent with what gfc_extract_int() did, we should  
> > add a check that the expression is an EXPR_CONSTANT of type  
> > BT_INTEGER, and otherwise call gfc_error(). Maybe this is already  
> > checked somewhere, in which case I've missed it.
> 
> I'll check the code, again.  If EXPR_CONSTANT isn't checked currently,
> I'll add a some code.
> 

I checked and a check against EXPR_CONSTANT is unneeded.  Lines 397 and
following are

      m = match_data_constant (&expr);
      if (m == MATCH_NO)
	goto syntax;
      if (m == MATCH_ERROR)
	return MATCH_ERROR;

The checking for EXPR_CONSTANT is done here.

The patch that I committed is attached.


2007-10-22  Steven G. Kargl  <kargl@gcc.gnu.org>

	* gfortran.h (gfc_data_value): Change repeat from unsigned int
	to mpz_t.
	* decl.c(top_val_list): Remove msg variable.  Use mpz_t for
	repeat count.
	* resolve.c (values):  Change left from unsigned int to mpz_t.
	(next_data_value): Change for mpz_t.
	(check_data_variable): Change ??? to FIXME in a comment.  Use
	"mpz_t left".
	(resolve_data ): Use "mpz_t left".

-- 
Steve

Index: decl.c
===================================================================
--- decl.c	(revision 129554)
+++ decl.c	(working copy)
@@ -383,7 +383,6 @@ top_val_list (gfc_data *data)
 {
   gfc_data_value *new, *tail;
   gfc_expr *expr;
-  const char *msg;
   match m;
 
   tail = NULL;
@@ -397,6 +396,7 @@ top_val_list (gfc_data *data)
 	return MATCH_ERROR;
 
       new = gfc_get_data_value ();
+      mpz_init (new->repeat);
 
       if (tail == NULL)
 	data->value = new;
@@ -408,19 +408,13 @@ top_val_list (gfc_data *data)
       if (expr->ts.type != BT_INTEGER || gfc_match_char ('*') != MATCH_YES)
 	{
 	  tail->expr = expr;
-	  tail->repeat = 1;
+	  mpz_set_ui (tail->repeat, 1);
 	}
       else
 	{
-	  signed int tmp;
-	  msg = gfc_extract_int (expr, &tmp);
+	  if (expr->ts.type == BT_INTEGER)
+	    mpz_set (tail->repeat, expr->value.integer);
 	  gfc_free_expr (expr);
-	  if (msg != NULL)
-	    {
-	      gfc_error (msg);
-	      return MATCH_ERROR;
-	    }
-	  tail->repeat = tmp;
 
 	  m = match_data_constant (&tail->expr);
 	  if (m == MATCH_NO)
Index: gfortran.h
===================================================================
--- gfortran.h	(revision 129554)
+++ gfortran.h	(working copy)
@@ -1776,7 +1776,7 @@ gfc_data_variable;
 
 typedef struct gfc_data_value
 {
-  unsigned int repeat;
+  mpz_t repeat;
   gfc_expr *expr;
   struct gfc_data_value *next;
 }
Index: resolve.c
===================================================================
--- resolve.c	(revision 129554)
+++ resolve.c	(working copy)
@@ -8002,7 +8002,7 @@ resolve_symbol (gfc_symbol *sym)
 static struct
 {
   gfc_data_value *vnode;
-  unsigned int left;
+  mpz_t left;
 }
 values;
 
@@ -8012,13 +8012,14 @@ values;
 static try
 next_data_value (void)
 {
-  while (values.left == 0)
+
+  while (mpz_cmp_ui (values.left, 0) == 0)
     {
       if (values.vnode->next == NULL)
 	return FAILURE;
 
       values.vnode = values.vnode->next;
-      values.left = values.vnode->repeat;
+      mpz_set (values.left, values.vnode->repeat);
     }
 
   return SUCCESS;
@@ -8121,23 +8122,23 @@ check_data_variable (gfc_data_variable *
       /* If we have more than one element left in the repeat count,
 	 and we have more than one element left in the target variable,
 	 then create a range assignment.  */
-      /* ??? Only done for full arrays for now, since array sections
+      /* FIXME: Only done for full arrays for now, since array sections
 	 seem tricky.  */
       if (mark == AR_FULL && ref && ref->next == NULL
-	  && values.left > 1 && mpz_cmp_ui (size, 1) > 0)
+	  && mpz_cmp_ui (values.left, 1) > 0 && mpz_cmp_ui (size, 1) > 0)
 	{
 	  mpz_t range;
 
-	  if (mpz_cmp_ui (size, values.left) >= 0)
+	  if (mpz_cmp (size, values.left) >= 0)
 	    {
-	      mpz_init_set_ui (range, values.left);
-	      mpz_sub_ui (size, size, values.left);
-	      values.left = 0;
+	      mpz_init_set (range, values.left);
+	      mpz_sub (size, size, values.left);
+	      mpz_set_ui (values.left, 0);
 	    }
 	  else
 	    {
 	      mpz_init_set (range, size);
-	      values.left -= mpz_get_ui (size);
+	      mpz_sub (values.left, values.left, size);
 	      mpz_set_ui (size, 0);
 	    }
 
@@ -8151,7 +8152,7 @@ check_data_variable (gfc_data_variable *
       /* Assign initial value to symbol.  */
       else
 	{
-	  values.left -= 1;
+	  mpz_sub_ui (values.left, values.left, 1);
 	  mpz_sub_ui (size, size, 1);
 
 	  t = gfc_assign_data_value (var->expr, values.vnode->expr, offset);
@@ -8324,13 +8325,17 @@ resolve_data_variables (gfc_data_variabl
    variables list, expanding iterators and such.  */
 
 static void
-resolve_data (gfc_data * d)
+resolve_data (gfc_data *d)
 {
+
   if (resolve_data_variables (d->var) == FAILURE)
     return;
 
   values.vnode = d->value;
-  values.left = (d->value == NULL) ? 0 : d->value->repeat;
+  if (d->value == NULL)
+    mpz_set_ui (values.left, 0);
+  else
+    mpz_set (values.left, d->value->repeat);
 
   if (traverse_data_var (d->var, &d->where) == FAILURE)
     return;