procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

re PR fortran/36112 (Bounds-checking on character length not working for array-constructors)

Browse source 
2008-06-17  Daniel Kraft  <d@domob.eu>

	PR fortran/36112
	* array.c (gfc_resolve_character_array_constructor):  Check that all
	elements with constant character length have the same one rather than
	fixing it if no typespec is given, emit an error if they don't.  Changed
	return type to "try" and return FAILURE for the case above.
	(gfc_resolve_array_constructor):  Removed unneeded call to
	gfc_resolve_character_array_constructor in this function.
	* gfortran.h (gfc_resolve_character_array_constructor):  Returns try.
	* trans-array.c (get_array_ctor_strlen):  Return length of first element
	rather than last element.
	* resolve.c (gfc_resolve_expr):  Handle FAILURE return from
	gfc_resolve_character_array_constructor.

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

	PR fortran/36112
	* gfortran.dg/bounds_check_array_ctor_1.f90:  New test.
	* gfortran.dg/bounds_check_array_ctor_2.f90:  New test.
	* gfortran.dg/bounds_check_array_ctor_3.f90:  New test.
	* gfortran.dg/bounds_check_array_ctor_4.f90:  New test.
	* gfortran.dg/bounds_check_array_ctor_5.f90:  New test.
	* gfortran.dg/bounds_check_array_ctor_6.f90:  New test.
	* gfortran.dg/bounds_check_array_ctor_7.f90:  New test.
	* gfortran.dg/bounds_check_array_ctor_8.f90:  New test.
	* gfortran.dg/arrayio_0.f90:  Fixed invalid array constructor.
	* gfortran.dg/char_cons_len.f90:  Ditto.
	* gfortran.dg/char_initializer_actual.f90:  Ditto.
	* gfortran.dg/pr15959.f90:  Ditto.
	* gfortran.dg/transfer_simplify_2.f90:  Ditto.
	* gfortran.dg/char_length_1.f90:  Changed expected error messages.

From-SVN: r136872
This commit is contained in:
Daniel Kraft 2008-06-17 22:24:20 +02:00 • committed by Daniel Kraft
parent 9d5c21c1f0
commit 88fec49fbb
20 changed files with 243 additions and 69 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

15
gcc/fortran/ChangeLog
View file

@ -1,3 +1,18 @@
2008-06-17 Daniel Kraft <d@domob.eu>
PR fortran/36112
* array.c (gfc_resolve_character_array_constructor): Check that all
elements with constant character length have the same one rather than
fixing it if no typespec is given, emit an error if they don't. Changed
return type to "try" and return FAILURE for the case above.
(gfc_resolve_array_constructor): Removed unneeded call to
gfc_resolve_character_array_constructor in this function.
* gfortran.h (gfc_resolve_character_array_constructor): Returns try.
* trans-array.c (get_array_ctor_strlen): Return length of first element
rather than last element.
* resolve.c (gfc_resolve_expr): Handle FAILURE return from
gfc_resolve_character_array_constructor.
2008-06-17 Paul Thomas <pault@gcc.gnu.org>
PR fortran/34396

115
gcc/fortran/array.c
View file

@ -1576,23 +1576,20 @@ resolve_array_list (gfc_constructor *p)
return t;
}
/* Resolve character array constructor. If it is a constant character array and
not specified character length, update character length to the maximum of
its element constructors' length. For arrays with fixed length, pad the
elements as necessary with needed_length. */
/* Resolve character array constructor. If it has a specified constant character
length, pad/trunkate the elements here; if the length is not specified and
all elements are of compile-time known length, emit an error as this is
invalid. */
void
try
gfc_resolve_character_array_constructor (gfc_expr *expr)
{
gfc_constructor *p;
int max_length;
bool generated_length;
int found_length;
gcc_assert (expr->expr_type == EXPR_ARRAY);
gcc_assert (expr->ts.type == BT_CHARACTER);
max_length = -1;
if (expr->ts.cl == NULL)
{
for (p = expr->value.constructor; p; p = p->next)
@ -1611,15 +1608,16 @@ gfc_resolve_character_array_constructor (gfc_expr *expr)
got_charlen:
generated_length = false;
found_length = -1;
if (expr->ts.cl->length == NULL)
{
/* Find the maximum length of the elements. Do nothing for variable
array constructor, unless the character length is constant or
there is a constant substring reference. */
/* Check that all constant string elements have the same length until
we reach the end or find a variable-length one. */
for (p = expr->value.constructor; p; p = p->next)
{
int current_length = -1;
gfc_ref *ref;
for (ref = p->expr->ref; ref; ref = ref->next)
if (ref->type == REF_SUBSTRING
@ -1628,32 +1626,43 @@ got_charlen:
break;
if (p->expr->expr_type == EXPR_CONSTANT)
max_length = MAX (p->expr->value.character.length, max_length);
current_length = p->expr->value.character.length;
else if (ref)
{
long j;
j = mpz_get_ui (ref->u.ss.end->value.integer)
- mpz_get_ui (ref->u.ss.start->value.integer) + 1;
max_length = MAX ((int) j, max_length);
current_length = (int) j;
}
else if (p->expr->ts.cl && p->expr->ts.cl->length
&& p->expr->ts.cl->length->expr_type == EXPR_CONSTANT)
{
long j;
j = mpz_get_si (p->expr->ts.cl->length->value.integer);
max_length = MAX ((int) j, max_length);
current_length = (int) j;
}
else
return;
return SUCCESS;
gcc_assert (current_length != -1);
if (found_length == -1)
found_length = current_length;
else if (found_length != current_length)
{
gfc_error ("Different CHARACTER lengths (%d/%d) in array"
" constructor at %L", found_length, current_length,
&p->expr->where);
return FAILURE;
}
gcc_assert (found_length == current_length);
}
if (max_length != -1)
{
/* Update the character length of the array constructor. */
expr->ts.cl->length = gfc_int_expr (max_length);
generated_length = true;
/* Real update follows below. */
}
gcc_assert (found_length != -1);
/* Update the character length of the array constructor. */
expr->ts.cl->length = gfc_int_expr (found_length);
}
else
{
@ -1664,33 +1673,35 @@ got_charlen:
/* If we've got a constant character length, pad according to this.
gfc_extract_int does check for BT_INTEGER and EXPR_CONSTANT and sets
max_length only if they pass. */
gfc_extract_int (expr->ts.cl->length, &max_length);
gfc_extract_int (expr->ts.cl->length, &found_length);
/* Now pad/trunkate the elements accordingly to the specified character
length. This is ok inside this conditional, as in the case above
(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;
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 (! cl
|| (current_length != -1 && current_length < found_length))
gfc_set_constant_character_len (found_length, p->expr, true);
}
}
/* Found a length to update to, do it for all element strings shorter than
the target length. */
if (max_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;
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 (generated_length || ! cl
|| (current_length != -1 && current_length < max_length))
gfc_set_constant_character_len (max_length, p->expr, true);
}
}
return SUCCESS;
}
@ -1704,8 +1715,10 @@ gfc_resolve_array_constructor (gfc_expr *expr)
t = resolve_array_list (expr->value.constructor);
if (t == SUCCESS)
t = gfc_check_constructor_type (expr);
if (t == SUCCESS && expr->ts.type == BT_CHARACTER)
gfc_resolve_character_array_constructor (expr);
/* gfc_resolve_character_array_constructor is called in gfc_resolve_expr after
the call to this function, so we don't need to call it here; if it was
called twice, an error message there would be duplicated. */
return t;
}

2
gcc/fortran/gfortran.h
View file

@ -2363,7 +2363,7 @@ void gfc_simplify_iterator_var (gfc_expr *);
try gfc_expand_constructor (gfc_expr *);
int gfc_constant_ac (gfc_expr *);
int gfc_expanded_ac (gfc_expr *);
void gfc_resolve_character_array_constructor (gfc_expr *);
try gfc_resolve_character_array_constructor (gfc_expr *);
try gfc_resolve_array_constructor (gfc_expr *);
try gfc_check_constructor_type (gfc_expr *);
try gfc_check_iter_variable (gfc_expr *);

4
gcc/fortran/resolve.c
View file

@ -4342,8 +4342,8 @@ gfc_resolve_expr (gfc_expr *e)
/* This provides the opportunity for the length of constructors with
character valued function elements to propagate the string length
to the expression. */
if (e->ts.type == BT_CHARACTER)
gfc_resolve_character_array_constructor (e);
if (t == SUCCESS && e->ts.type == BT_CHARACTER)
t = gfc_resolve_character_array_constructor (e);
break;

22
gcc/fortran/trans-array.c
View file

@ -1459,6 +1459,9 @@ get_array_ctor_all_strlen (stmtblock_t *block, gfc_expr *e, tree *len)
/* Figure out the string length of a character array constructor.
If len is NULL, don't calculate the length; this happens for recursive calls
when a sub-array-constructor is an element but not at the first position,
so when we're not interested in the length.
Returns TRUE if all elements are character constants. */
bool
@ -1470,16 +1473,20 @@ get_array_ctor_strlen (stmtblock_t *block, gfc_constructor * c, tree * len)
if (c == NULL)
{
*len = build_int_cstu (gfc_charlen_type_node, 0);
if (len)
*len = build_int_cstu (gfc_charlen_type_node, 0);
return is_const;
}
for (; c; c = c->next)
/* Loop over all constructor elements to find out is_const, but in len we
want to store the length of the first, not the last, element. We can
of course exit the loop as soon as is_const is found to be false. */
for (; c && is_const; c = c->next)
{
switch (c->expr->expr_type)
{
case EXPR_CONSTANT:
if (!(*len && INTEGER_CST_P (*len)))
if (len && !(*len && INTEGER_CST_P (*len)))
*len = build_int_cstu (gfc_charlen_type_node,
c->expr->value.character.length);
break;
@ -1491,14 +1498,19 @@ get_array_ctor_strlen (stmtblock_t *block, gfc_constructor * c, tree * len)
case EXPR_VARIABLE:
is_const = false;
get_array_ctor_var_strlen (c->expr, len);
if (len)
get_array_ctor_var_strlen (c->expr, len);
break;
default:
is_const = false;
get_array_ctor_all_strlen (block, c->expr, len);
if (len)
get_array_ctor_all_strlen (block, c->expr, len);
break;
}
/* After the first iteration, we don't want the length modified. */
len = NULL;
}
return is_const;

18
gcc/testsuite/ChangeLog
View file

@ -1,3 +1,21 @@
2008-06-17 Daniel Kraft <d@domob.eu>
PR fortran/36112
* gfortran.dg/bounds_check_array_ctor_1.f90: New test.
* gfortran.dg/bounds_check_array_ctor_2.f90: New test.
* gfortran.dg/bounds_check_array_ctor_3.f90: New test.
* gfortran.dg/bounds_check_array_ctor_4.f90: New test.
* gfortran.dg/bounds_check_array_ctor_5.f90: New test.
* gfortran.dg/bounds_check_array_ctor_6.f90: New test.
* gfortran.dg/bounds_check_array_ctor_7.f90: New test.
* gfortran.dg/bounds_check_array_ctor_8.f90: New test.
* gfortran.dg/arrayio_0.f90: Fixed invalid array constructor.
* gfortran.dg/char_cons_len.f90: Ditto.
* gfortran.dg/char_initializer_actual.f90: Ditto.
* gfortran.dg/pr15959.f90: Ditto.
* gfortran.dg/transfer_simplify_2.f90: Ditto.
* gfortran.dg/char_length_1.f90: Changed expected error messages.
2008-06-17 Paul Thomas <pault@gcc.gnu.org>
PR fortran/36366

2
gcc/testsuite/gfortran.dg/arrayio_0.f90
View file

@ -8,7 +8,7 @@
character(len=48), dimension(2) :: iue
equivalence (iu, iue)
integer, dimension(4) :: v = (/2,1,4,3/)
iu = (/"Vector","subscripts","not","allowed!"/)
iu = (/"Vector ","subscripts","not ","allowed! "/)
read (iu, '(a12/)') buff
read (iue(1), '(4a12)') buff
read (iu(4:1:-1), '(a12/)') buff

16
gcc/testsuite/gfortran.dg/bounds_check_array_ctor_1.f90 Normal file
View file

@ -0,0 +1,16 @@
! { dg-do run }
! { dg-options "-fbounds-check" }
! { dg-shouldfail "foo" }
!
! PR 36112
! Check correct bounds-checking behaviour for character-array-constructors.
call test ("this is long")
contains
subroutine test(s)
character(len=*) :: s
character(len=128) :: arr(2)
arr = (/ s, "abc" /)
end subroutine test
end
! { dg-output "Different CHARACTER lengths \\(12/3\\) in array constructor" }

16
gcc/testsuite/gfortran.dg/bounds_check_array_ctor_2.f90 Normal file
View file

@ -0,0 +1,16 @@
! { dg-do run }
! { dg-options "-fbounds-check" }
! { dg-shouldfail "foo" }
!
! PR 36112
! Check correct bounds-checking behaviour for character-array-constructors.
call test ("this is long")
contains
subroutine test(s)
character(len=*) :: s
character(len=128) :: arr(2)
arr = (/ "abc", s /)
end subroutine test
end
! { dg-output "Different CHARACTER lengths \\(3/12\\) in array constructor" }

9
gcc/testsuite/gfortran.dg/bounds_check_array_ctor_3.f90 Normal file
View file

@ -0,0 +1,9 @@
! { dg-do compile }
!
! PR 36112
! Check correct bounds-checking behaviour for character-array-constructors.
! This should not need any -fbounds-check and is enabled all the time.
character(len=128) :: arr(2) = (/ "abc", "foobar" /) ! { dg-error "Different CHARACTER lengths" }
arr = (/ "abc", "foobar" /) ! { dg-error "Different CHARACTER lengths" }
end

16
gcc/testsuite/gfortran.dg/bounds_check_array_ctor_4.f90 Normal file
View file

@ -0,0 +1,16 @@
! { dg-do run }
! { dg-options "-fbounds-check" }
! { dg-shouldfail "foo" }
!
! PR 36112
! Check correct bounds-checking behaviour for character-array-constructors.
call test ("short", "this is long")
contains
subroutine test(r, s)
character(len=*) :: r, s
character(len=128) :: arr(2)
arr = (/ r, s /)
end subroutine test
end
! { dg-output "Different CHARACTER lengths \\(5/12\\) in array constructor" }

10
gcc/testsuite/gfortran.dg/bounds_check_array_ctor_5.f90 Normal file
View file

@ -0,0 +1,10 @@
! { dg-do compile }
!
! PR 36112
! Check correct bounds-checking behaviour for character-array-constructors.
! No need for -fbounds-check, enabled unconditionally.
character(len=5) :: s = "hello"
character(len=128) :: arr(3)
arr = (/ "abc", "foo", s /) ! { dg-error "Different CHARACTER lengths" }
end

16
gcc/testsuite/gfortran.dg/bounds_check_array_ctor_6.f90 Normal file
View file

@ -0,0 +1,16 @@
! { dg-do run }
! { dg-options "-fbounds-check" }
! { dg-shouldfail "foo" }
!
! PR 36112
! Check correct bounds-checking behaviour for character-array-constructors.
call test ("short", "also5")
contains
subroutine test(r, s)
character(len=*) :: r, s
character(len=128) :: arr(3)
arr = (/ r, s, "this is too long" /)
end subroutine test
end
! { dg-output "Different CHARACTER lengths \\(5/16\\) in array constructor" }

16
gcc/testsuite/gfortran.dg/bounds_check_array_ctor_7.f90 Normal file
View file

@ -0,0 +1,16 @@
! { dg-do run }
! { dg-options "-fbounds-check" }
! { dg-shouldfail "foo" }
!
! PR 36112
! Check correct bounds-checking behaviour for character-array-constructors.
call test ("short")
contains
subroutine test(s)
character(len=*) :: s
character(len=128) :: arr(3)
arr = (/ "this is long", "this one too", s /)
end subroutine test
end
! { dg-output "Different CHARACTER lengths \\(12/5\\) in array constructor" }

16
gcc/testsuite/gfortran.dg/bounds_check_array_ctor_8.f90 Normal file
View file

@ -0,0 +1,16 @@
! { dg-do run }
! { dg-options "-fbounds-check" }
! { dg-shouldfail "foo" }
!
! PR 36112
! Check correct bounds-checking behaviour for character-array-constructors.
call test ("short")
contains
subroutine test(s)
character(len=*) :: s
character(len=128) :: arr(3)
arr = (/ s, "this is long", "this one too" /)
end subroutine test
end
! { dg-output "Different CHARACTER lengths \\(5/12\\) in array constructor" }

2
gcc/testsuite/gfortran.dg/char_cons_len.f90
View file

@ -3,7 +3,7 @@
! constructor, as an argument for LEN, would cause an ICE.
!
character(11) :: chr1, chr2
i = len ((/chr1, chr2, "ggg"/))
i = len ((/chr1, chr2, "ggg "/))
j = len ((/"abcdefghijk", chr1, chr2/))
k = len ((/'hello ','goodbye'/))
l = foo ("yes siree, Bob")

6
gcc/testsuite/gfortran.dg/char_initialiser_actual.f90
View file

@ -5,10 +5,10 @@
program char_initialiser
character*5, dimension(3) :: x
character*5, dimension(:), pointer :: y
x=(/"is Ja","ne Fo","nda"/)
x=(/"is Ja","ne Fo","nda "/)
call sfoo ("is Ja", x(1))
call afoo ((/"is Ja","ne Fo","nda"/), x)
y => pfoo ((/"is Ja","ne Fo","nda"/))
call afoo ((/"is Ja","ne Fo","nda "/), x)
y => pfoo ((/"is Ja","ne Fo","nda "/))
call afoo (y, x)
contains
subroutine sfoo(ch1, ch2)

7
gcc/testsuite/gfortran.dg/char_length_1.f90
View file

@ -7,12 +7,13 @@
! Contributed by Tobias Burnus <tobias.burnus@physik.fu-berlin.de>
!
program test
implicit none
character(10) :: a(3)
character(10) :: b(3)= &
(/ 'Takata ', 'Tanaka', 'Hayashi' /) ! { dg-error "same length" }
(/ 'Takata ', 'Tanaka', 'Hayashi' /) ! { dg-error "Different CHARACTER" }
character(4) :: c = "abcde" ! { dg-warning "being truncated" }
a = (/ 'Takata', 'Tanaka ', 'Hayashi' /) ! { dg-error "same length" }
a = (/ 'Takata', 'Tanaka ', 'Hayashi' /) ! { dg-error "Different CHARACTER" }
a = (/ 'Takata ', 'Tanaka ', 'Hayashi' /)
b = "abc"
b = "abc" ! { dg-error "no IMPLICIT" }
c = "abcdefg" ! { dg-warning "will be truncated" }
end program test

2
gcc/testsuite/gfortran.dg/pr15959.f90
View file

@ -1,5 +1,5 @@
! { dg-do run }
! Test initializer of character array. PR15959
character (*), parameter :: a (1:2) = (/'ab', 'abc'/)
character (*), parameter :: a (1:2) = (/'ab ', 'abc'/)
if (a(2) .ne. 'abc') call abort()
end

2
gcc/testsuite/gfortran.dg/transfer_simplify_2.f90
View file

@ -92,7 +92,7 @@ contains
end subroutine integer8_to_complex4
subroutine character16_to_complex8
character(16), parameter :: c1(2) = (/"abcdefghijklmnop","qrstuvwxyz1234567890"/)
character(16), parameter :: c1(2) = (/"abcdefghijklmnop","qrstuvwxyz123456"/)
character(16) :: c2(2) = c1
complex(8), parameter :: z1(2) = transfer (c1, (1.0_8,1.0_8), 2)
complex(8) :: z2(2)