Skip to content

R
riscv-gcc-1
Commit 7ab88654 by Tobias Burnus Committed by Tobias Burnus
Options

re PR fortran/33297 (SIZE intrinsic crashes gfortran on invalid usage) 

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.

From-SVN: r128424
parent a1dde7d4
Showing with 67 additions and 39 deletions
gcc/fortran/ChangeLog
2007-09-12 Tobias Burnus <burnus@net-b.de> 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/33284
PR fortran/33310 PR fortran/33310
* symbol.c (check_conflict): Add conflict between INTRINSIC and ENTRY * symbol.c (check_conflict): Add conflict between INTRINSIC and ENTRY
......
gcc/fortran/check.c
...@@ -33,6 +33,21 @@ along with GCC; see the file COPYING3. If not see ...@@ -33,6 +33,21 @@ along with GCC; see the file COPYING3. If not see
#include "intrinsic.h" #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. */ /* Check the type of an expression. */
static try static try
...@@ -124,6 +139,9 @@ kind_check (gfc_expr *k, int n, bt type) ...@@ -124,6 +139,9 @@ kind_check (gfc_expr *k, int n, bt type)
if (type_check (k, n, BT_INTEGER) == FAILURE) if (type_check (k, n, BT_INTEGER) == FAILURE)
return FAILURE; return FAILURE;
if (scalar_check (k, n) == FAILURE)
return FAILURE;
if (k->expr_type != EXPR_CONSTANT) if (k->expr_type != EXPR_CONSTANT)
{ {
gfc_error ("'%s' argument of '%s' intrinsic at %L must be a 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) ...@@ -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. */ /* Make sure two expressions have the same type. */
static try static try
...@@ -307,9 +310,9 @@ variable_check (gfc_expr *e, int n) ...@@ -307,9 +310,9 @@ variable_check (gfc_expr *e, int n)
/* Check the common DIM parameter for correctness. */ /* Check the common DIM parameter for correctness. */
static try 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; return SUCCESS;
if (dim == NULL) if (dim == NULL)
...@@ -325,7 +328,7 @@ dim_check (gfc_expr *dim, int n, int optional) ...@@ -325,7 +328,7 @@ dim_check (gfc_expr *dim, int n, int optional)
if (scalar_check (dim, n) == FAILURE) if (scalar_check (dim, n) == FAILURE)
return FAILURE; return FAILURE;
if (nonoptional_check (dim, n) == FAILURE) if (!optional && nonoptional_check (dim, n) == FAILURE)
return FAILURE; return FAILURE;
return SUCCESS; return SUCCESS;
...@@ -475,7 +478,7 @@ gfc_check_all_any (gfc_expr *mask, gfc_expr *dim) ...@@ -475,7 +478,7 @@ gfc_check_all_any (gfc_expr *mask, gfc_expr *dim)
if (logical_array_check (mask, 0) == FAILURE) if (logical_array_check (mask, 0) == FAILURE)
return FAILURE; return FAILURE;
if (dim_check (dim, 1, 1) == FAILURE) if (dim_check (dim, 1, false) == FAILURE)
return FAILURE; return FAILURE;
return SUCCESS; return SUCCESS;
...@@ -792,7 +795,7 @@ gfc_check_count (gfc_expr *mask, gfc_expr *dim, gfc_expr *kind) ...@@ -792,7 +795,7 @@ gfc_check_count (gfc_expr *mask, gfc_expr *dim, gfc_expr *kind)
{ {
if (logical_array_check (mask, 0) == FAILURE) if (logical_array_check (mask, 0) == FAILURE)
return FAILURE; return FAILURE;
if (dim_check (dim, 1, 1) == FAILURE) if (dim_check (dim, 1, false) == FAILURE)
return FAILURE; return FAILURE;
if (kind_check (kind, 2, BT_INTEGER) == FAILURE) if (kind_check (kind, 2, BT_INTEGER) == FAILURE)
return FAILURE; return FAILURE;
...@@ -821,7 +824,8 @@ gfc_check_cshift (gfc_expr *array, gfc_expr *shift, gfc_expr *dim) ...@@ -821,7 +824,8 @@ gfc_check_cshift (gfc_expr *array, gfc_expr *shift, gfc_expr *dim)
/* TODO: more requirements on shift parameter. */ /* 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 FAILURE;
return SUCCESS; return SUCCESS;
...@@ -955,7 +959,8 @@ gfc_check_eoshift (gfc_expr *array, gfc_expr *shift, gfc_expr *boundary, ...@@ -955,7 +959,8 @@ gfc_check_eoshift (gfc_expr *array, gfc_expr *shift, gfc_expr *boundary,
/* TODO: more restrictions on 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 FAILURE;
return SUCCESS; return SUCCESS;
...@@ -1233,14 +1238,8 @@ gfc_check_int (gfc_expr *x, gfc_expr *kind) ...@@ -1233,14 +1238,8 @@ gfc_check_int (gfc_expr *x, gfc_expr *kind)
if (numeric_check (x, 0) == FAILURE) if (numeric_check (x, 0) == FAILURE)
return FAILURE; return FAILURE;
if (kind != NULL) if (kind_check (kind, 1, BT_INTEGER) == FAILURE)
{ return FAILURE;
if (type_check (kind, 1, BT_INTEGER) == FAILURE)
return FAILURE;
if (scalar_check (kind, 1) == FAILURE)
return FAILURE;
}
return SUCCESS; return SUCCESS;
} }
...@@ -1365,7 +1364,7 @@ gfc_check_lbound (gfc_expr *array, gfc_expr *dim, gfc_expr *kind) ...@@ -1365,7 +1364,7 @@ gfc_check_lbound (gfc_expr *array, gfc_expr *dim, gfc_expr *kind)
if (dim != NULL) if (dim != NULL)
{ {
if (dim_check (dim, 1, 1) == FAILURE) if (dim_check (dim, 1, false) == FAILURE)
return FAILURE; return FAILURE;
if (dim_rank_check (dim, array, 1) == FAILURE) if (dim_rank_check (dim, array, 1) == FAILURE)
...@@ -1714,7 +1713,7 @@ gfc_check_minloc_maxloc (gfc_actual_arglist *ap) ...@@ -1714,7 +1713,7 @@ gfc_check_minloc_maxloc (gfc_actual_arglist *ap)
ap->next->next->expr = m; ap->next->next->expr = m;
} }
if (dim_check (d, 1, 1) == FAILURE) if (d && dim_check (d, 1, false) == FAILURE)
return FAILURE; return FAILURE;
if (d && dim_rank_check (d, a, 0) == FAILURE) if (d && dim_rank_check (d, a, 0) == FAILURE)
...@@ -1770,7 +1769,7 @@ check_reduction (gfc_actual_arglist *ap) ...@@ -1770,7 +1769,7 @@ check_reduction (gfc_actual_arglist *ap)
ap->next->next->expr = m; ap->next->next->expr = m;
} }
if (dim_check (d, 1, 1) == FAILURE) if (d && dim_check (d, 1, false) == FAILURE)
return FAILURE; return FAILURE;
if (d && dim_rank_check (d, a, 0) == 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) ...@@ -2338,10 +2337,7 @@ gfc_check_size (gfc_expr *array, gfc_expr *dim, gfc_expr *kind)
if (dim != NULL) if (dim != NULL)
{ {
if (type_check (dim, 1, BT_INTEGER) == FAILURE) if (dim_check (dim, 1, true) == FAILURE)
return FAILURE;
if (kind_value_check (dim, 1, gfc_default_integer_kind) == FAILURE)
return FAILURE; return FAILURE;
if (dim_rank_check (dim, array, 0) == 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) ...@@ -2392,7 +2388,10 @@ gfc_check_spread (gfc_expr *source, gfc_expr *dim, gfc_expr *ncopies)
return FAILURE; return FAILURE;
} }
if (dim_check (dim, 1, 0) == FAILURE) if (dim == NULL)
return FAILURE;
if (dim_check (dim, 1, false) == FAILURE)
return FAILURE; return FAILURE;
if (type_check (ncopies, 2, BT_INTEGER) == 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) ...@@ -2673,7 +2672,7 @@ gfc_check_ubound (gfc_expr *array, gfc_expr *dim, gfc_expr *kind)
if (dim != NULL) if (dim != NULL)
{ {
if (dim_check (dim, 1, 1) == FAILURE) if (dim_check (dim, 1, false) == FAILURE)
return FAILURE; return FAILURE;
if (dim_rank_check (dim, array, 0) == FAILURE) if (dim_rank_check (dim, array, 0) == FAILURE)
......
gcc/testsuite/ChangeLog
2007-09-12 Tobias Burnus <burnus@net-b.de> 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/33284
PR fortran/33310 PR fortran/33310
* gfortran.dg/conflicts_2.f90: New. * gfortran.dg/conflicts_2.f90: New.
gcc/testsuite/gfortran.dg/intrinsic_size.f90 0 → 100644
! { 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
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment