This is the mail archive of the
fortran@gcc.gnu.org
mailing list for the GNU Fortran project.
[Patch, Fortran] PR33297 - add scalar tests for kind and SIZE's dim
- From: Tobias Burnus <burnus at net-b dot de>
- To: "'fortran at gcc dot gnu dot org'" <fortran at gcc dot gnu dot org>, gcc-patches <gcc-patches at gcc dot gnu dot org>
- Date: Wed, 05 Sep 2007 23:49:04 +0200
- Subject: [Patch, Fortran] PR33297 - add scalar tests for kind and SIZE's dim
:ADDPATCH fortran:
gfortran was accepting arrays for the KIND= specifier in several
intrinsics. I now added scalar_check() to kind_check() as I could
neither find nor imagine an intrinsic which takes an array for KIND=. (I
also replaced the home-grown solution in gfc_check_int by a call to
kind_check.)
Additionally, the SIZE procedure was accepting arrays for the DIM=
specifier. The solution was to replace the home cooked version by a call
to dim_check.
This brought me to the issue of optional argument; the standard
specifies two kind of optionals:
a) The DIM= argument can be present or not; standard notation: [, dim]
and "DIM (optional)"
b) A passed dummy argument to DIM= can have the OPTIONAL attribute or
not; if OPTIONAL is not allowed, this is explicitly stated in the standard.
The current check in dim_check was (a). In order to use it for SIZE, I
had to change it to (b); (a) is now checked in the calling function;
additionally, I converted the "int" argument to "bool".
While checking whether I got the two optionals right, I realized that
for CSHIFT and EOSHIFT a non-present dummy is allowed, but gfortran
crashes in this case.
I filled PR 33317 to track this. (Note: Before and now also with this
patch, gfortran rejects this rather than generating crashing code.)
Build and regression tested with no failures than the -O3 inline
failures on x86_64-unknown-linux-gnu.
Ok for the trunk?
Tobias
2007-09-05 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-05 Tobias Burnus <burnus@net-b.de>
PR fortran/33297
* gfortran.dg/intrinsic_size.f90: New.
Index: gcc/fortran/check.c
===================================================================
--- gcc/fortran/check.c (Revision 128145)
+++ gcc/fortran/check.c (Arbeitskopie)
@@ -33,6 +33,21 @@ along with GCC; see the file COPYING3.
#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 opt
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_e
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_exp
{
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_e
/* 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_
/* 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 *ki
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_e
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_argl
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_exp
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_
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_e
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)
Index: gcc/testsuite/gfortran.dg/intrinsic_size.f90
===================================================================
--- gcc/testsuite/gfortran.dg/intrinsic_size.f90 (Revision 0)
+++ gcc/testsuite/gfortran.dg/intrinsic_size.f90 (Revision 0)
@@ -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