2007-09-12 Tobias Burnus <burnus@net-b.de>

	PR fortran/33297
	* check.c (scalar_check): Move up in the file.
	(kind_check): Call scalar_check.
	(dim_check): If optional, do not call nonoptional_check; use
	bool for optional.
	(gfc_check_all_any,gfc_check_count,gfc_check_cshift,gfc_check_eoshift,
	gfc_check_lbound,gfc_check_minloc_maxloc,check_reduction,
	gfc_check_spread,gfc_check_ubound): Use true/false instead of 0/1
	for dim_check; honor changed meaning of optional.
	(gfc_check_int): Replace checks by kind_check.
	(gfc_check_size): Replace checks by dim_check.

2007-09-12  Tobias Burnus  <burnus@net-b.de>

	PR fortran/33297
	* gfortran.dg/intrinsic_size.f90: New.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@128424 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index e726660..6a5914b 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,5 +1,19 @@
 2007-09-12  Tobias Burnus  <burnus@net-b.de>
 
+       PR fortran/33297
+       * check.c (scalar_check): Move up in the file.
+       (kind_check): Call scalar_check.
+       (dim_check): If optional, do not call nonoptional_check; use
+       bool for optional.
+       (gfc_check_all_any,gfc_check_count,gfc_check_cshift,gfc_check_eoshift,
+       gfc_check_lbound,gfc_check_minloc_maxloc,check_reduction,
+       gfc_check_spread,gfc_check_ubound): Use true/false instead of 0/1
+       for dim_check; honor changed meaning of optional.
+       (gfc_check_int): Replace checks by kind_check.
+       (gfc_check_size): Replace checks by dim_check.
+
+2007-09-12  Tobias Burnus  <burnus@net-b.de>
+
        PR fortran/33284
        PR fortran/33310
        * symbol.c (check_conflict): Add conflict between INTRINSIC and ENTRY

diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index ed824fe..5f3f92d 100644 (file)
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -33,6 +33,21 @@ along with GCC; see the file COPYING3.  If not see
 #include "intrinsic.h"
 
 
+/* Make sure an expression is a scalar.  */
+
+static try
+scalar_check (gfc_expr *e, int n)
+{
+  if (e->rank == 0)
+    return SUCCESS;
+
+  gfc_error ("'%s' argument of '%s' intrinsic at %L must be a scalar",
+            gfc_current_intrinsic_arg[n], gfc_current_intrinsic, &e->where);
+
+  return FAILURE;
+}
+
+
 /* Check the type of an expression.  */
 
 static try
@@ -124,6 +139,9 @@ kind_check (gfc_expr *k, int n, bt type)
   if (type_check (k, n, BT_INTEGER) == FAILURE)
     return FAILURE;
 
+  if (scalar_check (k, n) == FAILURE)
+    return FAILURE;
+
   if (k->expr_type != EXPR_CONSTANT)
     {
       gfc_error ("'%s' argument of '%s' intrinsic at %L must be a constant",
@@ -196,21 +214,6 @@ array_check (gfc_expr *e, int n)
 }
 
 
-/* Make sure an expression is a scalar.  */
-
-static try
-scalar_check (gfc_expr *e, int n)
-{
-  if (e->rank == 0)
-    return SUCCESS;
-
-  gfc_error ("'%s' argument of '%s' intrinsic at %L must be a scalar",
-            gfc_current_intrinsic_arg[n], gfc_current_intrinsic, &e->where);
-
-  return FAILURE;
-}
-
-
 /* Make sure two expressions have the same type.  */
 
 static try
@@ -307,9 +310,9 @@ variable_check (gfc_expr *e, int n)
 /* Check the common DIM parameter for correctness.  */
 
 static try
-dim_check (gfc_expr *dim, int n, int optional)
+dim_check (gfc_expr *dim, int n, bool optional)
 {
-  if (optional && dim == NULL)
+  if (dim == NULL)
     return SUCCESS;
 
   if (dim == NULL)
@@ -325,7 +328,7 @@ dim_check (gfc_expr *dim, int n, int optional)
   if (scalar_check (dim, n) == FAILURE)
     return FAILURE;
 
-  if (nonoptional_check (dim, n) == FAILURE)
+  if (!optional && nonoptional_check (dim, n) == FAILURE)
     return FAILURE;
 
   return SUCCESS;
@@ -475,7 +478,7 @@ gfc_check_all_any (gfc_expr *mask, gfc_expr *dim)
   if (logical_array_check (mask, 0) == FAILURE)
     return FAILURE;
 
-  if (dim_check (dim, 1, 1) == FAILURE)
+  if (dim_check (dim, 1, false) == FAILURE)
     return FAILURE;
 
   return SUCCESS;
@@ -792,7 +795,7 @@ gfc_check_count (gfc_expr *mask, gfc_expr *dim, gfc_expr *kind)
 {
   if (logical_array_check (mask, 0) == FAILURE)
     return FAILURE;
-  if (dim_check (dim, 1, 1) == FAILURE)
+  if (dim_check (dim, 1, false) == FAILURE)
     return FAILURE;
   if (kind_check (kind, 2, BT_INTEGER) == FAILURE)
     return FAILURE;
@@ -821,7 +824,8 @@ gfc_check_cshift (gfc_expr *array, gfc_expr *shift, gfc_expr *dim)
       /* TODO: more requirements on shift parameter.  */
     }
 
-  if (dim_check (dim, 2, 1) == FAILURE)
+  /* FIXME (PR33317): Allow optional DIM=.  */
+  if (dim_check (dim, 2, false) == FAILURE)
     return FAILURE;
 
   return SUCCESS;
@@ -955,7 +959,8 @@ gfc_check_eoshift (gfc_expr *array, gfc_expr *shift, gfc_expr *boundary,
       /* TODO: more restrictions on boundary.  */
     }
 
-  if (dim_check (dim, 1, 1) == FAILURE)
+  /* FIXME (PR33317): Allow optional DIM=.  */
+  if (dim_check (dim, 4, false) == FAILURE)
     return FAILURE;
 
   return SUCCESS;
@@ -1233,14 +1238,8 @@ gfc_check_int (gfc_expr *x, gfc_expr *kind)
   if (numeric_check (x, 0) == FAILURE)
     return FAILURE;
 
-  if (kind != NULL)
-    {
-      if (type_check (kind, 1, BT_INTEGER) == FAILURE)
-       return FAILURE;
-
-      if (scalar_check (kind, 1) == FAILURE)
-       return FAILURE;
-    }
+  if (kind_check (kind, 1, BT_INTEGER) == FAILURE)
+    return FAILURE;
 
   return SUCCESS;
 }
@@ -1365,7 +1364,7 @@ gfc_check_lbound (gfc_expr *array, gfc_expr *dim, gfc_expr *kind)
 
   if (dim != NULL)
     {
-      if (dim_check (dim, 1, 1) == FAILURE)
+      if (dim_check (dim, 1, false) == FAILURE)
        return FAILURE;
 
       if (dim_rank_check (dim, array, 1) == FAILURE)
@@ -1714,7 +1713,7 @@ gfc_check_minloc_maxloc (gfc_actual_arglist *ap)
       ap->next->next->expr = m;
     }
 
-  if (dim_check (d, 1, 1) == FAILURE)
+  if (d && dim_check (d, 1, false) == FAILURE)
     return FAILURE;
 
   if (d && dim_rank_check (d, a, 0) == FAILURE)
@@ -1770,7 +1769,7 @@ check_reduction (gfc_actual_arglist *ap)
       ap->next->next->expr = m;
     }
 
-  if (dim_check (d, 1, 1) == FAILURE)
+  if (d && dim_check (d, 1, false) == FAILURE)
     return FAILURE;
 
   if (d && dim_rank_check (d, a, 0) == FAILURE)
@@ -2338,10 +2337,7 @@ gfc_check_size (gfc_expr *array, gfc_expr *dim, gfc_expr *kind)
 
   if (dim != NULL)
     {
-      if (type_check (dim, 1, BT_INTEGER) == FAILURE)
-       return FAILURE;
-
-      if (kind_value_check (dim, 1, gfc_default_integer_kind) == FAILURE)
+      if (dim_check (dim, 1, true) == FAILURE)
        return FAILURE;
 
       if (dim_rank_check (dim, array, 0) == FAILURE)
@@ -2392,7 +2388,10 @@ gfc_check_spread (gfc_expr *source, gfc_expr *dim, gfc_expr *ncopies)
       return FAILURE;
     }
 
-  if (dim_check (dim, 1, 0) == FAILURE)
+  if (dim == NULL)
+    return FAILURE;
+
+  if (dim_check (dim, 1, false) == FAILURE)
     return FAILURE;
 
   if (type_check (ncopies, 2, BT_INTEGER) == FAILURE)
@@ -2673,7 +2672,7 @@ gfc_check_ubound (gfc_expr *array, gfc_expr *dim, gfc_expr *kind)
 
   if (dim != NULL)
     {
-      if (dim_check (dim, 1, 1) == FAILURE)
+      if (dim_check (dim, 1, false) == FAILURE)
        return FAILURE;
 
       if (dim_rank_check (dim, array, 0) == FAILURE)

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index f1bf054..ddddf59 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,5 +1,10 @@
 2007-09-12  Tobias Burnus  <burnus@net-b.de>
 
+       PR fortran/33297
+       * gfortran.dg/intrinsic_size.f90: New.
+
+2007-09-12  Tobias Burnus  <burnus@net-b.de>
+
        PR fortran/33284
        PR fortran/33310
        * gfortran.dg/conflicts_2.f90: New.

diff --git a/gcc/testsuite/gfortran.dg/intrinsic_size.f90 b/gcc/testsuite/gfortran.dg/intrinsic_size.f90
new file mode 100644 (file)
index 0000000..284c649
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intrinsic_size.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+!
+! Argument checking; dim and kind have to be scalar
+!
+! PR fortran/33297
+!
+  integer array(5), i1, i2
+  print *, size(array,(/i1,i2/))  ! { dg-error "must be a scalar" }
+  print *, size(array,i1,(/i1,i2/))  ! { dg-error "must be a scalar" }
+  end