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

re PR fortran/36176 (TRANSFER of constant substrings)

Browse source 
PR fortran/36176

	* target-memory.c (gfc_target_expr_size): Correctly treat
	substrings.
	(gfc_target_encode_expr): Likewise.
	(gfc_interpret_complex): Whitespace change.

	* gfortran.dg/transfer_simplify_9.f90: New test.

From-SVN: r135219
This commit is contained in:
François-Xavier Coudert 2008-05-12 15:51:27 +00:00
parent 7d2f0ecd61
commit b7d36ea3cc
4 changed files with 70 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
gcc/fortran/ChangeLog
View file

@ -1,3 +1,11 @@
2008-05-12 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
PR fortran/36176
* target-memory.c (gfc_target_expr_size): Correctly treat
substrings.
(gfc_target_encode_expr): Likewise.
(gfc_interpret_complex): Whitespace change.
2008-05-11 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/35719

38
gcc/fortran/target-memory.c
View file

@ -100,7 +100,16 @@ gfc_target_expr_size (gfc_expr *e)
case BT_LOGICAL:
return size_logical (e->ts.kind);
case BT_CHARACTER:
return size_character (e->value.character.length, e->ts.kind);
if (e->expr_type == EXPR_SUBSTRING && e->ref)
{
int start, end;
gfc_extract_int (e->ref->u.ss.start, &start);
gfc_extract_int (e->ref->u.ss.end, &end);
return size_character (MAX(end - start + 1, 0), e->ts.kind);
}
else
return size_character (e->value.character.length, e->ts.kind);
case BT_HOLLERITH:
return e->representation.length;
case BT_DERIVED:
@ -231,7 +240,8 @@ gfc_target_encode_expr (gfc_expr *source, unsigned char *buffer,
return encode_array (source, buffer, buffer_size);
gcc_assert (source->expr_type == EXPR_CONSTANT
|| source->expr_type == EXPR_STRUCTURE);
|| source->expr_type == EXPR_STRUCTURE
|| source->expr_type == EXPR_SUBSTRING);
/* If we already have a target-memory representation, we use that rather
than recreating one. */
@ -257,9 +267,24 @@ gfc_target_encode_expr (gfc_expr *source, unsigned char *buffer,
return encode_logical (source->ts.kind, source->value.logical, buffer,
buffer_size);
case BT_CHARACTER:
return encode_character (source->ts.kind, source->value.character.length,
source->value.character.string, buffer,
buffer_size);
if (source->expr_type == EXPR_CONSTANT || source->ref == NULL)
return encode_character (source->ts.kind,
source->value.character.length,
source->value.character.string, buffer,
buffer_size);
else
{
int start, end;
gcc_assert (source->expr_type == EXPR_SUBSTRING);
gfc_extract_int (source->ref->u.ss.start, &start);
gfc_extract_int (source->ref->u.ss.end, &end);
return encode_character (source->ts.kind,
MAX(end - start + 1, 0),
&source->value.character.string[start-1],
buffer, buffer_size);
}
case BT_DERIVED:
return encode_derived (source, buffer, buffer_size);
default:
@ -342,7 +367,8 @@ gfc_interpret_complex (int kind, unsigned char *buffer, size_t buffer_size,
{
int size;
size = gfc_interpret_float (kind, &buffer[0], buffer_size, real);
size += gfc_interpret_float (kind, &buffer[size], buffer_size - size, imaginary);
size += gfc_interpret_float (kind, &buffer[size], buffer_size - size,
imaginary);
return size;
}

9
gcc/testsuite/ChangeLog
View file

@ -1,7 +1,12 @@
2008-05-12 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
PR fortran/36176
* gfortran.dg/transfer_simplify_9.f90: New test.
2008-05-12 Paolo Carlini <paolo.carlini@oracle.com>
PR c++/35331
* g++.dg/cpp0x/vt-35331.C: New.
PR c++/35331
* g++.dg/cpp0x/vt-35331.C: New.
* g++.dg/cpp0x/pr32125.C: Adjust.
* g++.dg/cpp0x/pr32126.C: Likewise.
* g++.dg/cpp0x/pr31438.C: Likewise.

23
gcc/testsuite/gfortran.dg/transfer_simplify_9.f90 Normal file
View file

@ -0,0 +1,23 @@
! { dg-do run }
!
! Various checks on simplification of TRANSFER of substrings
character(len=4), parameter :: t = "xyzt"
integer, parameter :: w = transfer(t,0)
integer :: i = 1
if (transfer(t,0) /= w) call abort
if (transfer(t(:),0) /= w) call abort
if (transfer(t(1:4),0) /= w) call abort
if (transfer(t(i:i+3),0) /= w) call abort
if (transfer(t(1:1), 0_1) /= transfer("x", 0_1)) call abort
if (transfer(t(2:2), 0_1) /= transfer("y", 0_1)) call abort
if (transfer(t(i:i), 0_1) /= transfer("x", 0_1)) call abort
if (transfer(t(i+1:i+1), 0_1) /= transfer("y", 0_1)) call abort
if (transfer(t(1:2), 0_2) /= transfer("xy", 0_2)) call abort
if (transfer(t(3:4), 0_2) /= transfer("zt", 0_2)) call abort
if (transfer(transfer(-1, t), 0) /= -1) call abort
if (transfer(transfer(-1, t(:)), 0) /= -1) call abort
if (any (transfer(transfer(-1, (/t(1:1)/)), (/0_1/)) /= -1)) call abort
if (transfer(transfer(-1, t(1:1)), 0_1) /= -1) call abort
end