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-dev] minimise static buffer usage for conformance check


In

	http://gcc.gnu.org/ml/fortran/2009-03/msg00323.html

Steve commented on the use of static buffers[80] for multiple symbol names, 
each with an allowed length of 63 characters each. This patch changes 
gfc_check_conformance() to a printf()-like syntax. Now, there's only one big 
static buffer in the function, instead of one small buffer for each caller.


2009-04-02  Daniel Franke  <franke.daniel@gmail.com>

	* gfortran.h (gfc_check_conformance): Modified prototype to printf-style.
	* expr.c (gfc_check_conformance): Accept error-message chunks in 
	printf-style. Changed all callers.


Bootstrapped and regression tested on i686-pc-linux-gnu. 
Ok for dev-branch and trunk?

Cheers

	Daniel

Index: gfortran.h
===================================================================
--- gfortran.h	(revision 145368)
+++ gfortran.h	(working copy)
@@ -2442,7 +2442,7 @@ gfc_try gfc_specification_expr (gfc_expr
 int gfc_numeric_ts (gfc_typespec *);
 int gfc_kind_max (gfc_expr *, gfc_expr *);
 
-gfc_try gfc_check_conformance (const char *, gfc_expr *, gfc_expr *);
+gfc_try gfc_check_conformance (gfc_expr *, gfc_expr *, const char *, ...) ATTRIBUTE_PRINTF_3;
 gfc_try gfc_check_assign (gfc_expr *, gfc_expr *, int);
 gfc_try gfc_check_pointer_assign (gfc_expr *, gfc_expr *);
 gfc_try gfc_check_assign_symbol (gfc_symbol *, gfc_expr *);
Index: expr.c
===================================================================
--- expr.c	(revision 145369)
+++ expr.c	(working copy)
@@ -2767,18 +2767,25 @@ gfc_specification_expr (gfc_expr *e)
 /* Given two expressions, make sure that the arrays are conformable.  */
 
 gfc_try
-gfc_check_conformance (const char *optype_msgid, gfc_expr *op1, gfc_expr *op2)
+gfc_check_conformance (gfc_expr *op1, gfc_expr *op2, const char *optype_msgid, ...)
 {
   int op1_flag, op2_flag, d;
   mpz_t op1_size, op2_size;
   gfc_try t;
 
+  va_list argp;
+  char buffer[240];
+
   if (op1->rank == 0 || op2->rank == 0)
     return SUCCESS;
 
+  va_start (argp, optype_msgid);
+  vsnprintf (buffer, 240, optype_msgid, argp);
+  va_end (argp);
+
   if (op1->rank != op2->rank)
     {
-      gfc_error ("Incompatible ranks in %s (%d and %d) at %L", _(optype_msgid),
+      gfc_error ("Incompatible ranks in %s (%d and %d) at %L", _(buffer),
 		 op1->rank, op2->rank, &op1->where);
       return FAILURE;
     }
@@ -2793,7 +2800,7 @@ gfc_check_conformance (const char *optyp
       if (op1_flag && op2_flag && mpz_cmp (op1_size, op2_size) != 0)
 	{
 	  gfc_error ("Different shape for %s at %L on dimension %d "
-		     "(%d and %d)", _(optype_msgid), &op1->where, d + 1,
+		     "(%d and %d)", _(buffer), &op1->where, d + 1,
 		     (int) mpz_get_si (op1_size),
 		     (int) mpz_get_si (op2_size));
 
@@ -2941,7 +2948,7 @@ gfc_check_assign (gfc_expr *lvalue, gfc_
 
   /* Check size of array assignments.  */
   if (lvalue->rank != 0 && rvalue->rank != 0
-      && gfc_check_conformance ("array assignment", lvalue, rvalue) != SUCCESS)
+      && gfc_check_conformance (lvalue, rvalue, "array assignment") != SUCCESS)
     return FAILURE;
 
   if (rvalue->is_boz && lvalue->ts.type != BT_INTEGER
Index: intrinsic.c
===================================================================
--- intrinsic.c	(revision 145369)
+++ intrinsic.c	(working copy)
@@ -3473,14 +3473,13 @@ check_specific (gfc_intrinsic_sym *speci
       first_expr = arg->expr;
 
       for ( ; arg && arg->expr; arg = arg->next, n++)
-	{
-          char buffer[80];
-	  snprintf (buffer, 80, "arguments '%s' and '%s' for intrinsic '%s'",
-		    gfc_current_intrinsic_arg[0], gfc_current_intrinsic_arg[n],
-		    gfc_current_intrinsic);
-	  if (gfc_check_conformance (buffer, first_expr, arg->expr) == FAILURE)
-	    return FAILURE;
-	}
+	if (gfc_check_conformance (first_expr, arg->expr,
+				   "arguments '%s' and '%s' for "
+				   "intrinsic '%s'",
+				   gfc_current_intrinsic_arg[0],
+				   gfc_current_intrinsic_arg[n],
+				   gfc_current_intrinsic) == FAILURE)
+	  return FAILURE;
     }
 
   if (t == FAILURE)
Index: resolve.c
===================================================================
--- resolve.c	(revision 145368)
+++ resolve.c	(working copy)
@@ -1527,8 +1527,8 @@ resolve_elemental_actual (gfc_expr *expr
       /* Elemental procedure's array actual arguments must conform.  */
       if (e != NULL)
 	{
-	  if (gfc_check_conformance ("elemental procedure", arg->expr, e)
-	      == FAILURE)
+	  if (gfc_check_conformance (arg->expr, e,
+				     "elemental procedure") == FAILURE)
 	    return FAILURE;
 	}
       else
Index: arith.c
===================================================================
--- arith.c	(revision 145368)
+++ arith.c	(working copy)
@@ -1479,7 +1479,7 @@ reduce_binary_aa (arith (*eval) (gfc_exp
   rc = ARITH_OK;
   d = op2->value.constructor;
 
-  if (gfc_check_conformance ("elemental binary operation", op1, op2)
+  if (gfc_check_conformance (op1, op2, "elemental binary operation")
       != SUCCESS)
     rc = ARITH_INCOMMENSURATE;
   else
Index: check.c
===================================================================
--- check.c	(revision 145429)
+++ check.c	(working copy)
@@ -1719,13 +1719,11 @@ check_rest (bt type, int kind, gfc_actua
 	}
 
       for (tmp = arglist, m=1; tmp != arg; tmp = tmp->next, m++)
-        {
-	  char buffer[80];
-	  snprintf (buffer, 80, "arguments 'a%d' and 'a%d' for intrinsic '%s'",
-		    m, n, gfc_current_intrinsic);
-	  if (gfc_check_conformance (buffer, tmp->expr, x) == FAILURE)
+	if (gfc_check_conformance (tmp->expr, x,
+				   "arguments 'a%d' and 'a%d' for "
+				   "intrinsic '%s'", m, n,
+				   gfc_current_intrinsic) == FAILURE)
 	    return FAILURE;
-	}
     }
 
   return SUCCESS;
@@ -1914,15 +1912,13 @@ gfc_check_minloc_maxloc (gfc_actual_argl
   if (m != NULL && type_check (m, 2, BT_LOGICAL) == FAILURE)
     return FAILURE;
 
-  if (m != NULL)
-    {
-      char buffer[80];
-      snprintf (buffer, 80, "arguments '%s' and '%s' for intrinsic %s",
-		gfc_current_intrinsic_arg[0], gfc_current_intrinsic_arg[2],
-		gfc_current_intrinsic);
-      if (gfc_check_conformance (buffer, a, m) == FAILURE)
-	return FAILURE;
-    }
+  if (m != NULL
+      && gfc_check_conformance (a, m,
+				"arguments '%s' and '%s' for intrinsic %s",
+				gfc_current_intrinsic_arg[0],
+				gfc_current_intrinsic_arg[2],
+				gfc_current_intrinsic ) == FAILURE)
+    return FAILURE;
 
   return SUCCESS;
 }
@@ -1970,15 +1966,13 @@ check_reduction (gfc_actual_arglist *ap)
   if (m != NULL && type_check (m, 2, BT_LOGICAL) == FAILURE)
     return FAILURE;
 
-  if (m != NULL)
-    {
-      char buffer[80];
-      snprintf (buffer, 80, "arguments '%s' and '%s' for intrinsic %s",
-		gfc_current_intrinsic_arg[0], gfc_current_intrinsic_arg[2],
-		gfc_current_intrinsic);
-      if (gfc_check_conformance (buffer, a, m) == FAILURE)
-	return FAILURE;
-    }
+  if (m != NULL
+      && gfc_check_conformance (a, m,
+				"arguments '%s' and '%s' for intrinsic %s",
+				gfc_current_intrinsic_arg[0],
+				gfc_current_intrinsic_arg[2],
+				gfc_current_intrinsic) == FAILURE)
+    return FAILURE;
 
   return SUCCESS;
 }
@@ -2133,18 +2127,17 @@ gfc_check_null (gfc_expr *mold)
 gfc_try
 gfc_check_pack (gfc_expr *array, gfc_expr *mask, gfc_expr *vector)
 {
-  char buffer[80];
-
   if (array_check (array, 0) == FAILURE)
     return FAILURE;
 
   if (type_check (mask, 1, BT_LOGICAL) == FAILURE)
     return FAILURE;
 
-  snprintf (buffer, 80, "arguments '%s' and '%s' for intrinsic '%s'",
-	    gfc_current_intrinsic_arg[0], gfc_current_intrinsic_arg[1],
-	    gfc_current_intrinsic);
-  if (gfc_check_conformance (buffer, array, mask) == FAILURE)
+  if (gfc_check_conformance (array, mask,
+			     "arguments '%s' and '%s' for intrinsic '%s'",
+			     gfc_current_intrinsic_arg[0],
+			     gfc_current_intrinsic_arg[1],
+			     gfc_current_intrinsic) == FAILURE)
     return FAILURE;
 
   if (vector != NULL)

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