This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[Patch, Fortran] PR fortran/35723: Some fixes to restricted-expression handling
- From: Daniel Kraft <d at domob dot eu>
- To: Fortran List <fortran at gcc dot gnu dot org>, gcc-patches <gcc-patches at gcc dot gnu dot org>
- Date: Thu, 25 Sep 2008 17:39:01 +0200
- Subject: [Patch, Fortran] PR fortran/35723: Some fixes to restricted-expression handling
Hi,
this is more a compilation of several patches to form some more or less
working and compact unit.
1) I used Tobias' one-line patch from PR 35723 to allow PARAMETER
symbols in restricted expressions. This fixes the original PR.
2) I added checking of reference-chain subscripts (array and substring)
for EXPR_VARIABLEs to expr.c:check_restricted to fix the accepts-invalid
Tobias mentioned along with the patch (I probably should check the
indices for EXPR_SUBSTRINGs, too, right?). This was however not a
problem introduced by the patch but in fact another bug as demonstrated
by my accepts-invalid attached to the PR even for an unpatched gcc.
3) While working with runtime_subscript_dimension_3.f90, I discovered
that argument lists of function calls are not checked, either. I added
this check; for inquiry-type intrinsic calls it is disabled. I believe
this is the best we can do to conform to the standard at the moment.
This should not catch cases like:
INTEGER :: i = 1, v(42)
INTEGER :: arr(SIZE(v, i))
that should be rejected, right? I propose to defer this to a new PR as
it will probably involve not trivial changes and is not really related
to the PR being worked on.
4) To fix the duplicated error message problem reported also in the PR,
I added a suppress-errors to a function probably not supposed to report
errors; on the way, I found that handling the global gfc_suppress_error
is not consistent in the code and that some methods would change it and
fail to reset on return. I did some clean-up there and believe it is
better now (in addition to fixing the duplicate message problem).
I probably should change the test-case names to
restricted_expression_123.f90. What do you think? Any other comments?
Running a regression test now, but I believe there should not be any
(from a previous run where only one failure was introduced I fixed in
the meantime).
Do you think this patch is ok with my mentioned points (changing the
test names and adding the check for EXPR_SUBSTRINGs) if no regressions?
In any case, I would not backport this to 4.3 as it is a more or less
complicated patch. Or should I?
Yours,
Daniel
--
Done: Arc-Bar-Cav-Rog-Sam-Val-Wiz
To go: Hea-Kni-Mon-Pri-Ran-Tou
2008-09-25 Daniel Kraft <d@domob.eu>
PR fortran/35723
* gfortran.h (gfc_suppress_error): Removed from header.
(gfc_push_suppress_errors), (gfc_pop_suppress_errors): New methods.
* array.c (gfc_array_size): Use new gfc_push/pop_suppress_errors
instead of directly changing gfc_suppress_error.
* intrinsic.c (gfc_intrinsic_func_interface): Ditto.
(gfc_intrinsic_sub_interface): Ditto.
* error.c (suppress_errors): Made static from `gfc_suppress_error'.
(gfc_push_suppress_errors), (gfc_pop_suppress_errors): New methods.
(gfc_notify_std), (gfc_error): Use new static name of global.
* expr.c (check_arglist), (check_references): New methods.
(check_restricted): Check arglists and references of EXPR_FUNCTIONs
and EXPR_VARAIBALEs, respectively. Allow PARAMETER symbols.
* resolve.c (is_non_constant_shape_array): Suppress errors in function.
2008-09-25 Daniel Kraft <d@domob.eu>
PR fortran/35723
* gfortran.dg/runtime_subscript_dimension_1.f90: New test.
* gfortran.dg/runtime_subscript_dimension_2.f90: New test.
* gfortran.dg/runtime_subscript_dimension_3.f90: New test.
Index: gcc/fortran/intrinsic.c
===================================================================
--- gcc/fortran/intrinsic.c (revision 140628)
+++ gcc/fortran/intrinsic.c (working copy)
@@ -3584,7 +3584,8 @@ gfc_intrinsic_func_interface (gfc_expr *
return (do_simplify (expr->value.function.isym, expr) == FAILURE)
? MATCH_ERROR : MATCH_YES;
- gfc_suppress_error = !error_flag;
+ if (!error_flag)
+ gfc_push_suppress_errors ();
flag = 0;
for (actual = expr->value.function.actual; actual; actual = actual->next)
@@ -3597,7 +3598,8 @@ gfc_intrinsic_func_interface (gfc_expr *
isym = specific = gfc_find_function (name);
if (isym == NULL)
{
- gfc_suppress_error = 0;
+ if (!error_flag)
+ gfc_pop_suppress_errors ();
return MATCH_NO;
}
@@ -3607,7 +3609,11 @@ gfc_intrinsic_func_interface (gfc_expr *
&& gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Function '%s' "
"as initialization expression at %L", name,
&expr->where) == FAILURE)
- return MATCH_ERROR;
+ {
+ if (!error_flag)
+ gfc_pop_suppress_errors ();
+ return MATCH_ERROR;
+ }
gfc_current_intrinsic_where = &expr->where;
@@ -3619,7 +3625,8 @@ gfc_intrinsic_func_interface (gfc_expr *
if (gfc_check_min_max (expr->value.function.actual) == SUCCESS)
goto got_specific;
- gfc_suppress_error = 0;
+ if (!error_flag)
+ gfc_pop_suppress_errors ();
return MATCH_NO;
}
@@ -3627,7 +3634,7 @@ gfc_intrinsic_func_interface (gfc_expr *
incarnations. If the generic name is also a specific, we check
that name last, so that any error message will correspond to the
specific. */
- gfc_suppress_error = 1;
+ gfc_push_suppress_errors ();
if (isym->generic)
{
@@ -3637,15 +3644,19 @@ gfc_intrinsic_func_interface (gfc_expr *
if (specific == isym)
continue;
if (check_specific (specific, expr, 0) == SUCCESS)
- goto got_specific;
+ {
+ gfc_pop_suppress_errors ();
+ goto got_specific;
+ }
}
}
- gfc_suppress_error = !error_flag;
+ gfc_pop_suppress_errors ();
if (check_specific (isym, expr, error_flag) == FAILURE)
{
- gfc_suppress_error = 0;
+ if (!error_flag)
+ gfc_pop_suppress_errors ();
return MATCH_NO;
}
@@ -3655,7 +3666,9 @@ got_specific:
expr->value.function.isym = specific;
gfc_intrinsic_symbol (expr->symtree->n.sym);
- gfc_suppress_error = 0;
+ if (!error_flag)
+ gfc_pop_suppress_errors ();
+
if (do_simplify (specific, expr) == FAILURE)
return MATCH_ERROR;
@@ -3695,7 +3708,8 @@ gfc_intrinsic_sub_interface (gfc_code *c
if (isym == NULL)
return MATCH_NO;
- gfc_suppress_error = !error_flag;
+ if (!error_flag)
+ gfc_push_suppress_errors ();
init_arglist (isym);
@@ -3715,7 +3729,8 @@ gfc_intrinsic_sub_interface (gfc_code *c
/* The subroutine corresponds to an intrinsic. Allow errors to be
seen at this point. */
- gfc_suppress_error = 0;
+ if (!error_flag)
+ gfc_pop_suppress_errors ();
if (isym->resolve.s1 != NULL)
isym->resolve.s1 (c);
@@ -3737,7 +3752,8 @@ gfc_intrinsic_sub_interface (gfc_code *c
return MATCH_YES;
fail:
- gfc_suppress_error = 0;
+ if (!error_flag)
+ gfc_pop_suppress_errors ();
return MATCH_NO;
}
Index: gcc/fortran/array.c
===================================================================
--- gcc/fortran/array.c (revision 140628)
+++ gcc/fortran/array.c (working copy)
@@ -2073,14 +2073,13 @@ gfc_array_size (gfc_expr *array, mpz_t *
{
expand_info expand_save;
gfc_ref *ref;
- int i, flag;
+ int i;
gfc_try t;
switch (array->expr_type)
{
case EXPR_ARRAY:
- flag = gfc_suppress_error;
- gfc_suppress_error = 1;
+ gfc_push_suppress_errors ();
expand_save = current_expand;
@@ -2091,7 +2090,8 @@ gfc_array_size (gfc_expr *array, mpz_t *
iter_stack = NULL;
t = expand_constructor (array->value.constructor);
- gfc_suppress_error = flag;
+
+ gfc_pop_suppress_errors ();
if (t == FAILURE)
mpz_clear (*result);
Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h (revision 140628)
+++ gcc/fortran/gfortran.h (working copy)
@@ -768,7 +768,10 @@ typedef struct
#endif
-extern int gfc_suppress_error;
+/* Suppress error messages or re-enable them. */
+
+void gfc_push_suppress_errors (void);
+void gfc_pop_suppress_errors (void);
/* Character length structures hold the expression that gives the
Index: gcc/fortran/error.c
===================================================================
--- gcc/fortran/error.c (revision 140628)
+++ gcc/fortran/error.c (working copy)
@@ -30,13 +30,33 @@ along with GCC; see the file COPYING3.
#include "flags.h"
#include "gfortran.h"
-int gfc_suppress_error = 0;
+static int suppress_errors = 0;
static int terminal_width, buffer_flag, errors, warnings;
static gfc_error_buf error_buffer, warning_buffer, *cur_error_buffer;
+/* Go one level deeper suppressing errors. */
+
+void
+gfc_push_suppress_errors (void)
+{
+ gcc_assert (suppress_errors >= 0);
+ ++suppress_errors;
+}
+
+
+/* Leave one level of error suppressing. */
+
+void
+gfc_pop_suppress_errors (void)
+{
+ gcc_assert (suppress_errors > 0);
+ --suppress_errors;
+}
+
+
/* Per-file error initialization. */
void
@@ -764,7 +784,7 @@ gfc_notify_std (int std, const char *noc
if ((gfc_option.allow_std & std) != 0 && !warning)
return SUCCESS;
- if (gfc_suppress_error)
+ if (suppress_errors)
return warning ? SUCCESS : FAILURE;
cur_error_buffer = warning ? &warning_buffer : &error_buffer;
@@ -850,7 +870,7 @@ gfc_error (const char *nocmsgid, ...)
{
va_list argp;
- if (gfc_suppress_error)
+ if (suppress_errors)
return;
error_buffer.flag = 1;
Index: gcc/fortran/expr.c
===================================================================
--- gcc/fortran/expr.c (revision 140628)
+++ gcc/fortran/expr.c (working copy)
@@ -2498,6 +2498,64 @@ restricted_intrinsic (gfc_expr *e)
}
+/* Check the expressions of an actual arglist. Used by check_restricted. */
+
+static gfc_try
+check_arglist (gfc_actual_arglist* arg, gfc_try (*checker) (gfc_expr*))
+{
+ for (; arg; arg = arg->next)
+ if (checker (arg->expr) == FAILURE)
+ return FAILURE;
+
+ return SUCCESS;
+}
+
+
+/* Check the subscription expressions of a reference chain with a checking
+ function; used by check_restricted. */
+
+static gfc_try
+check_references (gfc_ref* ref, gfc_try (*checker) (gfc_expr*))
+{
+ int dim;
+
+ if (!ref)
+ return SUCCESS;
+
+ switch (ref->type)
+ {
+ case REF_ARRAY:
+ for (dim = 0; dim != ref->u.ar.dimen; ++dim)
+ {
+ if (checker (ref->u.ar.start[dim]) == FAILURE)
+ return FAILURE;
+ if (checker (ref->u.ar.end[dim]) == FAILURE)
+ return FAILURE;
+ if (checker (ref->u.ar.stride[dim]) == FAILURE)
+ return FAILURE;
+ }
+ break;
+
+ case REF_COMPONENT:
+ /* Nothing needed, just proceed to next reference. */
+ break;
+
+ case REF_SUBSTRING:
+ if (checker (ref->u.ss.start) == FAILURE)
+ return FAILURE;
+ if (checker (ref->u.ss.end) == FAILURE)
+ return FAILURE;
+ break;
+
+ default:
+ gcc_unreachable ();
+ break;
+ }
+
+ return check_references (ref->next, checker);
+}
+
+
/* Verify that an expression is a restricted expression. Like its
cousin check_init_expr(), an error message is generated if we
return FAILURE. */
@@ -2505,7 +2563,7 @@ restricted_intrinsic (gfc_expr *e)
static gfc_try
check_restricted (gfc_expr *e)
{
- gfc_symbol *sym;
+ gfc_symbol* sym;
gfc_try t;
if (e == NULL)
@@ -2521,8 +2579,22 @@ check_restricted (gfc_expr *e)
break;
case EXPR_FUNCTION:
- t = e->value.function.esym ? external_spec_function (e)
- : restricted_intrinsic (e);
+ if (e->value.function.esym)
+ {
+ t = check_arglist (e->value.function.actual, &check_restricted);
+ if (t == SUCCESS)
+ t = external_spec_function (e);
+ }
+ else
+ {
+ if (e->value.function.isym && e->value.function.isym->inquiry)
+ t = SUCCESS;
+ else
+ t = check_arglist (e->value.function.actual, &check_restricted);
+
+ if (t == SUCCESS)
+ t = restricted_intrinsic (e);
+ }
break;
case EXPR_VARIABLE:
@@ -2556,6 +2628,10 @@ check_restricted (gfc_expr *e)
break;
}
+ /* Check reference chain if any. */
+ if (check_references (e->ref, &check_restricted) == FAILURE)
+ break;
+
/* gfc_is_formal_arg broadcasts that a formal argument list is being
processed in resolve.c(resolve_formal_arglist). This is done so
that host associated dummy array indices are accepted (PR23446).
@@ -2565,6 +2641,7 @@ check_restricted (gfc_expr *e)
|| sym->attr.use_assoc
|| sym->attr.dummy
|| sym->attr.implied_index
+ || sym->attr.flavor == FL_PARAMETER
|| sym->ns != gfc_current_ns
|| (sym->ns->proc_name != NULL
&& sym->ns->proc_name->attr.flavor == FL_MODULE)
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c (revision 140628)
+++ gcc/fortran/resolve.c (working copy)
@@ -7066,6 +7066,8 @@ is_non_constant_shape_array (gfc_symbol
int i;
bool not_constant;
+ gfc_push_suppress_errors ();
+
not_constant = false;
if (sym->as != NULL)
{
@@ -7085,6 +7087,9 @@ is_non_constant_shape_array (gfc_symbol
not_constant = true;
}
}
+
+ gfc_pop_suppress_errors ();
+
return not_constant;
}
Index: gcc/testsuite/gfortran.dg/runtime_subscript_dimension_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/runtime_subscript_dimension_1.f90 (revision 0)
+++ gcc/testsuite/gfortran.dg/runtime_subscript_dimension_1.f90 (revision 0)
@@ -0,0 +1,25 @@
+! { dg-do compile }
+! { dg-options "-pedantic -ffixed-form" }
+
+! PR fortran/35723
+! An argument subscript into a parameter array was not allowed as
+! dimension. Check this is fixed.
+
+! Contributed by Dick Hendrickson <dick.hendrickson@gmail.com>
+
+ call vf0016( 1, 2, 3)
+
+ end
+ SUBROUTINE VF0016(nf1,nf2,nf3)
+ CHARACTER(LEN=9,KIND=1),DIMENSION(3), PARAMETER
+ $ :: TEST_STRINGS =
+ $ (/' HI','ABC ',' CDEFG '/)
+ CHARACTER :: TEST_ARRAY
+ $(LEN_TRIM(ADJUSTL(TEST_STRINGS(nf1))),
+ $ SUM(LEN_TRIM(ADJUSTL(TEST_STRINGS))),
+ $ LEN_TRIM(ADJUSTL(ADJUSTR(TEST_STRINGS(3)))),
+ $ SUM(LEN_TRIM(ADJUSTL(ADJUSTR(TEST_STRINGS(NF1:NF3:NF2))))) )
+
+ print *, 2, 10, 5, 7
+ print *, shape (test_array)
+ end
Index: gcc/testsuite/gfortran.dg/runtime_subscript_dimension_3.f90
===================================================================
--- gcc/testsuite/gfortran.dg/runtime_subscript_dimension_3.f90 (revision 0)
+++ gcc/testsuite/gfortran.dg/runtime_subscript_dimension_3.f90 (revision 0)
@@ -0,0 +1,24 @@
+! { dg-do compile }
+
+! PR fortran/35723
+! Check that a dummy-argument array with non-restricted subscript is
+! rejected and some more reference-checks.
+
+PROGRAM main
+ IMPLICIT NONE
+ CALL test (5, (/ 1, 2, 3, 4, 5, 6, 7, 8, 9 /), "0123456789" )
+
+CONTAINS
+
+ SUBROUTINE test (n, arr, str)
+ IMPLICIT NONE
+ INTEGER :: n, arr(:)
+ CHARACTER(len=10) :: str
+
+ INTEGER :: i = 5
+ INTEGER :: ok1(arr(n)), ok2(LEN_TRIM (str(3:n)))
+ INTEGER :: wrong1(arr(i)) ! { dg-error "'i' cannot appear" }
+ INTEGER :: wrong2(LEN_TRIM (str(i:n))) ! { dg-error "'i' cannot appear" }
+ END SUBROUTINE test
+
+END PROGRAM main
Index: gcc/testsuite/gfortran.dg/runtime_subscript_dimension_2.f90
===================================================================
--- gcc/testsuite/gfortran.dg/runtime_subscript_dimension_2.f90 (revision 0)
+++ gcc/testsuite/gfortran.dg/runtime_subscript_dimension_2.f90 (revision 0)
@@ -0,0 +1,25 @@
+! { dg-do compile }
+! { dg-options "-pedantic -ffixed-form" }
+
+! PR fortran/35723
+! Check that a program using a local variable subscript is still rejected.
+
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+
+ call vf0016( 1, 2, 3)
+
+ end
+ SUBROUTINE VF0016(nf1,nf2,nf3)
+ CHARACTER(LEN=9,KIND=1),DIMENSION(3), PARAMETER
+ $ :: TEST_STRINGS =
+ $ (/' HI','ABC ',' CDEFG '/)
+ INTEGER :: i = 2
+ CHARACTER :: TEST_ARRAY
+ $(LEN_TRIM(ADJUSTL(TEST_STRINGS(i))), ! { dg-error "'i' cannot appear" }
+ $ SUM(LEN_TRIM(ADJUSTL(TEST_STRINGS))),
+ $ LEN_TRIM(ADJUSTL(ADJUSTR(TEST_STRINGS(3)))),
+ $ SUM(LEN_TRIM(ADJUSTL(ADJUSTR(TEST_STRINGS(NF1:NF3:NF2))))) )
+
+ print *, 2, 10, 5, 7
+ print *, shape (test_array)
+ end