OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

PR fortran/36517, fortran/36492

Browse Source 
2008-06-18  Daniel Kraft  <d@domob.eu>

	PR fortran/36517, fortran/36492
	* gfortran.dg/array_constructor_25.f03:  New test.
	* gfortran.dg/array_constructor_26.f03:  New test.
	* gfortran.dg/array_constructor_27.f03:  New test.
	* gfortran.dg/array_constructor_28.f03:  New test.
	* gfortran.dg/array_constructor_29.f03:  New test.
	* gfortran.dg/array_constructor_30.f03:  New test.
	* gfortran.dg/array_constructor_type_19.f03:  New test.
	* gfortran.dg/array_constructor_type_20.f03:  New test.
	* gfortran.dg/array_constructor_type_21.f03:  New test.

2008-06-18  Daniel Kraft  <d@domob.eu>

	PR fortran/36517, fortran/36492
	* array.c (gfc_resolve_character_array_constructor):  Call
	gfc_set_constant_character_len with changed length-chec argument.
	* decl.c (gfc_set_constant_character_len):  Changed array argument to
	be a generic length-checking argument that can be used for correct
	checking with typespec and in special cases where the should-be length
	is different from the target length.
	(build_struct):  Call gfc_set_constant_character_len with changed length
	checking argument and introduced additional checks for exceptional
	conditions on invalid code.
	(add_init_expr_to_sym), (do_parm):  Call gfc_set_constant_character_len
	with changed argument.
	* match.h (gfc_set_constant_character_len):  Changed third argument to
	int for the should-be length rather than bool.

From-SVN: r136894
This commit is contained in:
Daniel Kraft 2008-06-18 15:53:32 +02:00 committed by Daniel Kraft
parent f0c882ab6f
commit d28480827e
14 changed files with 212 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
gcc/fortran/ChangeLog
View File

@ -1,3 +1,20 @@
2008-06-18 Daniel Kraft <d@domob.eu>
PR fortran/36517, fortran/36492
* array.c (gfc_resolve_character_array_constructor): Call
gfc_set_constant_character_len with changed length-chec argument.
* decl.c (gfc_set_constant_character_len): Changed array argument to
be a generic length-checking argument that can be used for correct
checking with typespec and in special cases where the should-be length
is different from the target length.
(build_struct): Call gfc_set_constant_character_len with changed length
checking argument and introduced additional checks for exceptional
conditions on invalid code.
(add_init_expr_to_sym), (do_parm): Call gfc_set_constant_character_len
with changed argument.
* match.h (gfc_set_constant_character_len): Changed third argument to
int for the should-be length rather than bool.
2008-06-17 Daniel Kraft <d@domob.eu>
PR fortran/36112

36
gcc/fortran/array.c
View File

@ -1680,25 +1680,29 @@ got_charlen:
(without typespec) all elements are verified to have the same length
anyway. */
if (found_length != -1)
for (p = expr->value.constructor; p; p = p->next)
if (p->expr->expr_type == EXPR_CONSTANT)
{
gfc_expr *cl = NULL;
int current_length = -1;
for (p = expr->value.constructor; p; p = p->next)
if (p->expr->expr_type == EXPR_CONSTANT)
{
gfc_expr *cl = NULL;
int current_length = -1;
bool has_ts;
if (p->expr->ts.cl && p->expr->ts.cl->length)
{
cl = p->expr->ts.cl->length;
gfc_extract_int (cl, &current_length);
}
if (p->expr->ts.cl && p->expr->ts.cl->length)
{
cl = p->expr->ts.cl->length;
gfc_extract_int (cl, &current_length);
}
/* If gfc_extract_int above set current_length, we implicitly
know the type is BT_INTEGER and it's EXPR_CONSTANT. */
/* If gfc_extract_int above set current_length, we implicitly
know the type is BT_INTEGER and it's EXPR_CONSTANT. */
if (! cl
|| (current_length != -1 && current_length < found_length))
gfc_set_constant_character_len (found_length, p->expr, true);
}
has_ts = (expr->ts.cl && expr->ts.cl->length_from_typespec);
if (! cl
|| (current_length != -1 && current_length < found_length))
gfc_set_constant_character_len (found_length, p->expr,
has_ts ? -1 : found_length);
}
}
return SUCCESS;

58
gcc/fortran/decl.c
View File

@ -1084,10 +1084,12 @@ build_sym (const char *name, gfc_charlen *cl,
/* Set character constant to the given length. The constant will be padded or
truncated. */
truncated. If we're inside an array constructor without a typespec, we
additionally check that all elements have the same length; check_len -1
means no checking. */
void
gfc_set_constant_character_len (int len, gfc_expr *expr, bool array)
gfc_set_constant_character_len (int len, gfc_expr *expr, int check_len)
{
gfc_char_t *s;
int slen;
@ -1110,10 +1112,11 @@ gfc_set_constant_character_len (int len, gfc_expr *expr, bool array)
/* Apply the standard by 'hand' otherwise it gets cleared for
initializers. */
if (array && slen < len && !(gfc_option.allow_std & GFC_STD_GNU))
if (check_len != -1 && slen != check_len
&& !(gfc_option.allow_std & GFC_STD_GNU))
gfc_error_now ("The CHARACTER elements of the array constructor "
"at %L must have the same length (%d/%d)",
&expr->where, slen, len);
&expr->where, slen, check_len);
s[len] = '\0';
gfc_free (expr->value.character.string);
@ -1269,7 +1272,7 @@ add_init_expr_to_sym (const char *name, gfc_expr **initp, locus *var_locus)
gfc_constructor * p;
if (init->expr_type == EXPR_CONSTANT)
gfc_set_constant_character_len (len, init, false);
gfc_set_constant_character_len (len, init, -1);
else if (init->expr_type == EXPR_ARRAY)
{
/* Build a new charlen to prevent simplification from
@ -1280,7 +1283,7 @@ add_init_expr_to_sym (const char *name, gfc_expr **initp, locus *var_locus)
init->ts.cl->length = gfc_copy_expr (sym->ts.cl->length);
for (p = init->value.constructor; p; p = p->next)
gfc_set_constant_character_len (len, p->expr, false);
gfc_set_constant_character_len (len, p->expr, -1);
}
}
}
@ -1402,19 +1405,48 @@ build_struct (const char *name, gfc_charlen *cl, gfc_expr **init,
/* Should this ever get more complicated, combine with similar section
in add_init_expr_to_sym into a separate function. */
if (c->ts.type == BT_CHARACTER && !c->pointer && c->initializer)
if (c->ts.type == BT_CHARACTER && !c->pointer && c->initializer && c->ts.cl
&& c->ts.cl->length && c->ts.cl->length->expr_type == EXPR_CONSTANT)
{
int len = mpz_get_si (c->ts.cl->length->value.integer);
int len;
gcc_assert (c->ts.cl && c->ts.cl->length);
gcc_assert (c->ts.cl->length->expr_type == EXPR_CONSTANT);
gcc_assert (c->ts.cl->length->ts.type == BT_INTEGER);
len = mpz_get_si (c->ts.cl->length->value.integer);
if (c->initializer->expr_type == EXPR_CONSTANT)
gfc_set_constant_character_len (len, c->initializer, false);
gfc_set_constant_character_len (len, c->initializer, -1);
else if (mpz_cmp (c->ts.cl->length->value.integer,
c->initializer->ts.cl->length->value.integer))
{
bool has_ts;
gfc_constructor *ctor = c->initializer->value.constructor;
for (;ctor ; ctor = ctor->next)
if (ctor->expr->expr_type == EXPR_CONSTANT)
gfc_set_constant_character_len (len, ctor->expr, true);
bool first = true;
int first_len;
has_ts = (c->initializer->ts.cl
&& c->initializer->ts.cl->length_from_typespec);
for (; ctor; ctor = ctor->next)
{
/* Remember the length of the first element for checking that
all elements *in the constructor* have the same length. This
need not be the length of the LHS! */
if (first)
{
gcc_assert (ctor->expr->expr_type == EXPR_CONSTANT);
gcc_assert (ctor->expr->ts.type == BT_CHARACTER);
first_len = ctor->expr->value.character.length;
first = false;
}
if (ctor->expr->expr_type == EXPR_CONSTANT)
gfc_set_constant_character_len (len, ctor->expr,
has_ts ? -1 : first_len);
}
}
}
@ -5822,7 +5854,7 @@ do_parm (void)
&& init->expr_type == EXPR_CONSTANT
&& init->ts.type == BT_CHARACTER)
gfc_set_constant_character_len (
mpz_get_si (sym->ts.cl->length->value.integer), init, false);
mpz_get_si (sym->ts.cl->length->value.integer), init, -1);
else if (sym->ts.type == BT_CHARACTER && sym->ts.cl != NULL
&& sym->ts.cl->length == NULL)
{

2
gcc/fortran/match.h
View File

@ -147,7 +147,7 @@ match gfc_match_final_decl (void);
match gfc_match_implicit_none (void);
match gfc_match_implicit (void);
void gfc_set_constant_character_len (int, gfc_expr *, bool);
void gfc_set_constant_character_len (int, gfc_expr *, int);
/* Matchers for attribute declarations. */
match gfc_match_allocatable (void);

13
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,16 @@
2008-06-18 Daniel Kraft <d@domob.eu>
PR fortran/36517, fortran/36492
* gfortran.dg/array_constructor_25.f03: New test.
* gfortran.dg/array_constructor_26.f03: New test.
* gfortran.dg/array_constructor_27.f03: New test.
* gfortran.dg/array_constructor_28.f03: New test.
* gfortran.dg/array_constructor_29.f03: New test.
* gfortran.dg/array_constructor_30.f03: New test.
* gfortran.dg/array_constructor_type_19.f03: New test.
* gfortran.dg/array_constructor_type_20.f03: New test.
* gfortran.dg/array_constructor_type_21.f03: New test.
2008-06-17 Daniel Kraft <d@domob.eu>
PR fortran/36112

12
gcc/testsuite/gfortran.dg/array_constructor_25.f03 Normal file
View File

@ -0,0 +1,12 @@
! { dg-do compile }
! { dg-options "-std=f2003" }
! PR fortran/36492
! Check for incorrect error message with -std=f2003.
! Reduced test based on the one from comment #4, PR 36492.
type t
character (2) :: arr (1) = [ "a" ]
end type t
end

18
gcc/testsuite/gfortran.dg/array_constructor_26.f03 Normal file
View File

@ -0,0 +1,18 @@
! { dg-do compile }
! PR fortran/36492
! Check for incorrect error message with -std=f2003.
! Test from comment #4, PR 36492 causing ICE.
MODULE WinData
IMPLICIT NONE
INTEGER (1), PARAMETER :: MAXFLD = 25_1, MAXHED = 5_1, MAXCHR = 80_1
integer :: i
TYPE TWindowData
CHARACTER (MAX_FLD_HED, 1) :: DWFdHd(MAXFLD) = [(" ", i = 1, MAXFLD)]
! { dg-error "no IMPLICIT type" "" { target *-*-* } 12 }
! { dg-error "specification expression" "" { target *-*-* } 12 }
END TYPE TWindowData
END MODULE WinData
! { dg-final { cleanup-modules "WinData" } }

15
gcc/testsuite/gfortran.dg/array_constructor_27.f03 Normal file
View File

@ -0,0 +1,15 @@
! { dg-do compile }
! PR fortran/36492
! Check for incorrect error message with -std=f2003.
! Reduced test triggering the ICE mentioned in comment #4, PR 36492.
implicit none
type t
character (a) :: arr (1) = [ "a" ]
! { dg-error "no IMPLICIT type" "" { target *-*-* } 10 }
! { dg-error "specification expression" "" { target *-*-* } 10 }
end type t
end

11
gcc/testsuite/gfortran.dg/array_constructor_28.f03 Normal file
View File

@ -0,0 +1,11 @@
! { dg-do compile }
! { dg-options "-std=f2003" }
! PR fortran/36492
! Check that the error is still emitted for really incorrect constructor.
type t
character (2) :: arr (2) = [ "a", "ab" ] ! { dg-error "Different CHARACTER" }
end type t
end

13
gcc/testsuite/gfortran.dg/array_constructor_29.f03 Normal file
View File

@ -0,0 +1,13 @@
! { dg-do compile }
! PR fortran/36492
! Similar to the ICE-test, but now test it works for real constants.
implicit none
integer, parameter :: a = 42
type t
character (a) :: arr (1) = [ "a" ]
end type t
end

16
gcc/testsuite/gfortran.dg/array_constructor_30.f03 Normal file
View File

@ -0,0 +1,16 @@
! { dg-do compile }
! PR fortran/36492
! Similar to the ICE-test, but now test for complaint about constant
! specification expression.
implicit none
integer :: a = 42
type t
character (a) :: arr (1) = [ "a" ]
! { dg-error "in the expression" "" { target *-*-* } 11 }
! { dg-error "specification expression" "" { target *-*-* } 11 }
end type t
end

9
gcc/testsuite/gfortran.dg/array_constructor_type_19.f03 Normal file
View File

@ -0,0 +1,9 @@
! { dg-do compile }
! { dg-options "-std=f2003" }
! PR fortran/36517
! Check for incorrect error message with -std=f2003.
! This is the test of comment #1, PR 36517.
print *, [ character(len=2) :: 'a', 'bb' ]
end

11
gcc/testsuite/gfortran.dg/array_constructor_type_20.f03 Normal file
View File

@ -0,0 +1,11 @@
! { dg-do compile }
! { dg-options "-std=f2003" }
! PR fortran/36517
! Check for incorrect error message with -std=f2003.
! This is the original test from PR 36517.
CHARACTER (len=*) MY_STRING(1:3)
PARAMETER ( MY_STRING = (/ CHARACTER (len=3) :: "AC", "B", "C" /) )
CHARACTER (len=*), PARAMETER :: str(2) = [ CHARACTER (len=3) :: 'A', 'cc' ]
END

11
gcc/testsuite/gfortran.dg/array_constructor_type_21.f03 Normal file
View File

@ -0,0 +1,11 @@
! { dg-do compile }
! { dg-options "-std=f2003" }
! PR fortran/36492
! Check that it works with a typespec even for not-the-same-length elements.
type t
character (1) :: arr (2) = [ character(len=2) :: "a", "ab" ]
end type t
end