Skip to content

R
riscv-gcc-1
Commit 8d48826b by Steven G. Kargl
Options

re PR fortran/67805 (ICE on array constructor with wrong character specification) 

2015-10-24  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/67805
	* array.c (gfc_match_array_constructor): Check for error from type
	spec matching.
	* decl.c (char_len_param_value): Check for valid of charlen parameter.
	Reap dead code dating to 2008.
	match.c (gfc_match_type_spec): Special case the keyword use in REAL.

2015-10-24  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/67805
	* gfortran.dg/pr67805.f90: New testcase.
	* gfortran.dg/array_constructor_26.f03: Update testcase.
	* gfortran.dg/array_constructor_27.f03: Ditto.
	* gfortran.dg/char_type_len_2.f90: Ditto.
	* gfortran.dg/pr67802.f90: Ditto.
	* gfortran.dg/used_before_typed_3.f90: Ditto.

From-SVN: r229287
parent ae1158c4
Showing with 114 additions and 34 deletions
gcc/fortran/ChangeLog
2015-10-24 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/67805
* array.c (gfc_match_array_constructor): Check for error from type
spec matching.
* decl.c (char_len_param_value): Check for valid of charlen parameter.
Reap dead code dating to 2008.
match.c (gfc_match_type_spec): Special case the keyword use in REAL.
2015-10-23 Mikhail Maltsev <maltsevm@gmail.com>
* trans-common.c (create_common): Adjust to use flag_checking.
......
gcc/fortran/array.c
......@@ -1080,7 +1080,8 @@ gfc_match_array_constructor (gfc_expr **result)
/* Try to match an optional "type-spec ::" */
gfc_clear_ts (&ts);
gfc_new_undo_checkpoint (changed_syms);
if (gfc_match_type_spec (&ts) == MATCH_YES)
m = gfc_match_type_spec (&ts);
if (m == MATCH_YES)
{
seen_ts = (gfc_match (" ::") == MATCH_YES);
......@@ -1102,6 +1103,11 @@ gfc_match_array_constructor (gfc_expr **result)
}
}
}
else if (m == MATCH_ERROR)
{
gfc_restore_last_undo_checkpoint ();
goto cleanup;
}
if (seen_ts)
gfc_drop_last_undo_checkpoint ();
......
gcc/fortran/decl.c
......@@ -715,36 +715,59 @@ char_len_param_value (gfc_expr **expr, bool *deferred)
if ((*expr)->expr_type == EXPR_FUNCTION)
{
if ((*expr)->value.function.actual
&& (*expr)->value.function.actual->expr->symtree)
if ((*expr)->ts.type == BT_INTEGER
|| ((*expr)->ts.type == BT_UNKNOWN
&& strcmp((*expr)->symtree->name, "null") != 0))
return MATCH_YES;
goto syntax;
}
else if ((*expr)->expr_type == EXPR_CONSTANT)
{
/* F2008, 4.4.3.1: The length is a type parameter; its kind is
processor dependent and its value is greater than or equal to zero.
F2008, 4.4.3.2: If the character length parameter value evaluates
to a negative value, the length of character entities declared
is zero. */
if ((*expr)->ts.type == BT_INTEGER)
{
gfc_expr *e;
e = (*expr)->value.function.actual->expr;
if (e->symtree->n.sym->attr.flavor == FL_PROCEDURE
&& e->expr_type == EXPR_VARIABLE)
{
if (e->symtree->n.sym->ts.type == BT_UNKNOWN)
goto syntax;
if (e->symtree->n.sym->ts.type == BT_CHARACTER
&& e->symtree->n.sym->ts.u.cl
&& e->symtree->n.sym->ts.u.cl->length->ts.type == BT_UNKNOWN)
goto syntax;
}
if (mpz_cmp_si ((*expr)->value.integer, 0) < 0)
mpz_set_si ((*expr)->value.integer, 0);
}
else
goto syntax;
}
else if ((*expr)->expr_type == EXPR_ARRAY)
goto syntax;
else if ((*expr)->expr_type == EXPR_VARIABLE)
{
gfc_expr *e;
e = gfc_copy_expr (*expr);
/* This catches the invalid code "[character(m(2:3)) :: 'x', 'y']",
which causes an ICE if gfc_reduce_init_expr() is called. */
if (e->ref && e->ref->u.ar.type == AR_UNKNOWN
&& e->ref->u.ar.dimen_type[0] == DIMEN_RANGE)
goto syntax;
gfc_reduce_init_expr (e);
if ((e->ref && e->ref->u.ar.type != AR_ELEMENT)
|| (!e->ref && e->expr_type == EXPR_ARRAY))
{
gfc_free_expr (e);
goto syntax;
}
/* F2008, 4.4.3.1: The length is a type parameter; its kind is processor
dependent and its value is greater than or equal to zero.
F2008, 4.4.3.2: If the character length parameter value evaluates to
a negative value, the length of character entities declared is zero. */
if ((*expr)->expr_type == EXPR_CONSTANT
&& mpz_cmp_si ((*expr)->value.integer, 0) < 0)
mpz_set_si ((*expr)->value.integer, 0);
gfc_free_expr (e);
}
return m;
syntax:
gfc_error ("Conflict in attributes of function argument at %C");
gfc_error ("Scalar INTEGER expression expected at %L", &(*expr)->where);
return MATCH_ERROR;
}
......
gcc/fortran/match.c
......@@ -1939,6 +1939,11 @@ kind_selector:
if (m == MATCH_NO)
m = MATCH_YES; /* No kind specifier found. */
/* gfortran may have matched REAL(a=1), which is the keyword form of the
intrinsic procedure. */
if (ts->type == BT_REAL && m == MATCH_ERROR)
m = MATCH_NO;
return m;
}
......
gcc/testsuite/gfortran.dg/array_constructor_26.f03
......@@ -11,7 +11,6 @@ MODULE WinData
integer :: i
TYPE TWindowData
CHARACTER (MAX_FLD_HED, 1) :: DWFdHd(MAXFLD) = [(" ", i = 1, MAXFLD)]
! { dg-error "no IMPLICIT type" "" { target *-*-* } 13 }
! { dg-error "specification expression" "" { target *-*-* } 13 }
END TYPE TWindowData
END MODULE WinData
gcc/testsuite/gfortran.dg/array_constructor_27.f03
......@@ -9,7 +9,6 @@ implicit none
type t
character (a) :: arr (1) = [ "a" ]
! { dg-error "no IMPLICIT type" "" { target *-*-* } 11 }
! { dg-error "specification expression" "" { target *-*-* } 11 }
end type t
......
gcc/testsuite/gfortran.dg/char_type_len_2.f90
! { dg-do compile }
! PR31251 Non-integer character length leads to segfault
! Submitted by Jerry DeLisle <jvdelisle@gcc.gnu.org>
character(len=2.3) :: s ! { dg-error "must be of INTEGER type" }
character(kind=1,len=4.3) :: t ! { dg-error "must be of INTEGER type" }
!
! Updated to deal with the fix for PR fortran/67805.
!
character(len=2.3) :: s ! { dg-error "INTEGER expression expected" }
character(kind=1,len=4.3) :: t ! { dg-error "INTEGER expression expected" }
character(len=,,7.2,kind=1) :: u ! { dg-error "Syntax error in CHARACTER declaration" }
character(len=7,kind=2) :: v ! ! { dg-error "Kind 2 is not supported for CHARACTER" }
character(kind=2) :: w ! ! { dg-error "Kind 2 is not supported for CHARACTER" }
......
gcc/testsuite/gfortran.dg/large_real_kind_3.F90
! { dg-do run }
! { dg-require-effective-target fortran_large_real }
! { dg-xfail-if "" { "*-*-freebsd*" } { "*" } { "" } }
! Testing erf and erfc library calls on large real kinds (larger than kind=8)
implicit none
......
gcc/testsuite/gfortran.dg/pr67802.f90
......@@ -2,8 +2,8 @@
! PR fortran/67802
! Original code contribute by gerhard.steinmetz.fortran at t-online.de
program p
character(1.) :: c1 = ' ' ! { dg-error "must be of INTEGER" }
character(1d1) :: c2 = ' ' ! { dg-error "must be of INTEGER" }
character((0.,1.)) :: c3 = ' ' ! { dg-error "must be of INTEGER" }
character(.true.) :: c4 = ' ' ! { dg-error "must be of INTEGER" }
character(1.) :: c1 = ' ' ! { dg-error "INTEGER expression expected" }
character(1d1) :: c2 = ' ' ! { dg-error "INTEGER expression expected" }
character((0.,1.)) :: c3 = ' ' ! { dg-error "INTEGER expression expected" }
character(.true.) :: c4 = ' ' ! { dg-error "INTEGER expression expected" }
end program p
gcc/testsuite/gfortran.dg/pr67805.f90 0 → 100644
! { dg-do compile }
! PR fortran/67805
! Original code contributed by Gerhard Steinmetz
! gerhard dot steinmetz dot fortran at t-online dot de
!
subroutine p
integer, parameter :: n = 1
integer, parameter :: m(3) = [1, 2, 3]
character(len=1) s(2)
s = [character((m(1))) :: 'x', 'y'] ! OK.
s = [character(m(1)) :: 'x', 'y'] ! OK.
s = [character(m) :: 'x', 'y'] ! { dg-error "INTEGER expression expected" }
! The next line should case an error, but causes an ICE.
s = [character(m(2:3)) :: 'x', 'y'] ! { dg-error "INTEGER expression expected" }
call foo(s)
s = [character('') :: 'x', 'y'] ! { dg-error "INTEGER expression expected" }
s = [character(['']) :: 'x', 'y'] ! { dg-error "INTEGER expression expected" }
s = [character([.true.]) :: 'x', 'y'] ! { dg-error "INTEGER expression expected" }
s = [character([.false.]) :: 'x', 'y'] ! { dg-error "INTEGER expression expected" }
s = [character([1.]) :: 'x', 'y'] ! { dg-error "INTEGER expression expected" }
s = [character([1d1]) :: 'x', 'y'] ! { dg-error "INTEGER expression expected" }
s = [character([(0.,1.)]) :: 'x', 'y'] ! { dg-error "INTEGER expression expected" }
s = [character([null()]) :: 'x', 'y'] ! { dg-error "INTEGER expression expected" }
s = [character(null()) :: 'x', 'y'] ! { dg-error "INTEGER expression expected" }
call foo(s)
end subroutine p
subroutine q
print *, '1: ', [character(.true.) :: 'x', 'y'] ! { dg-error "INTEGER expression expected" }
print *, '2: ', [character(.false.) :: 'x', 'y'] ! { dg-error "INTEGER expression expected" }
print *, '3: ', [character(1.) :: 'x', 'y'] ! { dg-error "INTEGER expression expected" }
print *, '4: ', [character(1d1) :: 'x', 'y'] ! { dg-error "INTEGER expression expected" }
print *, '5: ', [character((0.,1.)) :: 'x', 'y'] ! { dg-error "INTEGER expression expected" }
print *, '6: ', [character(null()) :: 'x', 'y'] ! { dg-error "INTEGER expression expected" }.
end subroutine q
gcc/testsuite/gfortran.dg/used_before_typed_3.f90
......@@ -17,14 +17,14 @@ CONTAINS
test1 = "foobar"
END FUNCTION test1
CHARACTER(len=x) FUNCTION test2 (x) ! { dg-bogus "used before|of INTEGER" }
CHARACTER(len=x) FUNCTION test2 (x) ! { dg-error "of INTEGER" }
IMPLICIT INTEGER(a-z)
test2 = "foobar"
END FUNCTION test2
END MODULE testmod
CHARACTER(len=i) FUNCTION test3 (i) ! { dg-bogus "used before|of INTEGER" }
CHARACTER(len=i) FUNCTION test3 (i)
! i is IMPLICIT INTEGER by default
test3 = "foobar"
END FUNCTION test3
......
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