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

re PR fortran/37099 (Wrong results when comparing a character array to a character expression)

Browse source 
2008-09-04  Daniel Kraft  <d@domob.eu>

	* PR fortran/37099
	* expr.c (simplify_const_ref): Update expression's character length
	when pulling out a substring reference.

2008-09-04  Daniel Kraft  <d@domob.eu>

	PR fortran/37099
	* gfortran.dg/string_compare_1.f90: New text.
	* gfortran.dg/string_compare_2.f90: New text.
	* gfortran.dg/string_compare_3.f90: New text.

From-SVN: r139997
This commit is contained in:
Daniel Kraft 2008-09-04 21:16:13 +02:00 • committed by Daniel Kraft
parent 5feec5c1de
commit d555161825
6 changed files with 130 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
gcc/fortran/ChangeLog
View file

@ -1,3 +1,9 @@
2008-09-04 Daniel Kraft <d@domob.eu>
* PR fortran/37099
* expr.c (simplify_const_ref): Update expression's character length
when pulling out a substring reference.
2008-09-04 Ian Lance Taylor <iant@google.com>
* symbol.c (generate_isocbinding_symbol): Compare

35
gcc/fortran/expr.c
View file

@ -1454,7 +1454,40 @@ simplify_const_ref (gfc_expr *p)
for (; cons; cons = cons->next)
{
cons->expr->ref = gfc_copy_ref (p->ref->next);
simplify_const_ref (cons->expr);
if (simplify_const_ref (cons->expr) == FAILURE)
return FAILURE;
}
/* If this is a CHARACTER array and we possibly took a
substring out of it, update the type-spec's character
length according to the first element (as all should have
the same length). */
if (p->ts.type == BT_CHARACTER)
{
int string_len;
gcc_assert (p->ref->next);
gcc_assert (!p->ref->next->next);
gcc_assert (p->ref->next->type == REF_SUBSTRING);
if (p->value.constructor)
{
const gfc_expr* first = p->value.constructor->expr;
gcc_assert (first->expr_type == EXPR_CONSTANT);
gcc_assert (first->ts.type == BT_CHARACTER);
string_len = first->value.character.length;
}
else
string_len = 0;
if (!p->ts.cl)
{
p->ts.cl = gfc_get_charlen ();
p->ts.cl->next = NULL;
p->ts.cl->length = NULL;
}
gfc_free_expr (p->ts.cl->length);
p->ts.cl->length = gfc_int_expr (string_len);
}
}
gfc_free_ref_list (p->ref);

7
gcc/testsuite/ChangeLog
View file

@ -1,3 +1,10 @@
2008-09-04 Daniel Kraft <d@domob.eu>
PR fortran/37099
* gfortran.dg/string_compare_1.f90: New text.
* gfortran.dg/string_compare_2.f90: New text.
* gfortran.dg/string_compare_3.f90: New text.
2008-09-04 H.J. Lu <hongjiu.lu@intel.com>
PR rtl-optimization/37243

25
gcc/testsuite/gfortran.dg/string_compare_1.f90 Normal file
View file

@ -0,0 +1,25 @@
! { dg-do run }
! PR fortran/37099
! Check for correct results when comparing array-section-substrings.
PROGRAM main
IMPLICIT NONE
CHARACTER(*), PARAMETER :: exprs(1) = (/ 'aa' /)
CHARACTER(*), PARAMETER :: al1 = 'a';
CHARACTER(len=LEN (al1)) :: al2 = al1;
LOGICAL :: tmp(1), tmp2(1)
tmp = (exprs(1:1)(1:1) == al1)
tmp2 = (exprs(1:1)(1:1) == al2)
PRINT '(L1)', tmp
PRINT '(L1)', tmp2
IF (.NOT. tmp(1) .OR. .NOT. tmp2(1)) THEN
CALL abort ()
END IF
END PROGRAM main

37
gcc/testsuite/gfortran.dg/string_compare_2.f90 Normal file
View file

@ -0,0 +1,37 @@
! { dg-do run }
! PR fortran/37099
! Check for correct results when comparing array-section-substrings.
! This is the original test from the PR.
! Contributed by Dominique d'Humieres <dominiq@lps.ens.fr>
module xparams
integer,parameter :: exprbeg=100,exprend=154
character(*),dimension(exprbeg:exprend),parameter :: &
exprs=(/'nint() ','log10() ','sqrt() ','acos() ','asin() ', &
'atan() ','cosh() ','sinh() ','tanh() ','int() ', &
'cos() ','sin() ','tan() ','exp() ','log() ','abs() ',&
'delta() ','step() ','rect() ','max(,) ','min(,) ','bj0() ',&
'bj1() ','bjn(,) ','by0() ','by1() ','byn(,) ','logb(,) ',&
'erf() ','erfc() ','lgamma()','gamma() ','csch() ','sech() ',&
'coth() ','lif(,,) ','gaus() ','sinc() ','atan2(,)','mod(,) ',&
'nthrt(,)','ramp() ','fbi() ','fbiq() ','uran(,) ','aif(,,,)',&
'sgn() ','cbrt() ','fact() ','somb() ','bk0() ','bk1() ',&
'bkn(,) ','bbi(,,) ','bbiq(,,)'/)
logical :: tmp(55,26)
character(26) :: al = 'abcdefghijklmnopqrstuvwxyz'
end
program pack_bug
use xparams
do i = 1, 1
tmp(:,i) = (exprs(:)(1:1)==al(i:i))
print '(55L1)', exprs(:)(1:1)=='a'
print '(55L1)', tmp(:,i)
if (any ((exprs(:)(1:1)=='a') .neqv. tmp(:,i))) then
call abort ()
end if
end do
end

21
gcc/testsuite/gfortran.dg/string_compare_3.f90 Normal file
View file

@ -0,0 +1,21 @@
! { dg-do run }
! PR fortran/37099
! Check for correct results when comparing array-section-substrings.
! This is the test from comment #1 of the PR.
! Contributed by Dominique d'Humieres <dominiq@lps.ens.fr>
integer, parameter :: n = 10
integer, parameter :: ilst(n) = (/(i,i=1,n)/)
character(*), parameter :: c0lst(n) = (/(char(96+i),i=1,n)/)
character(*), parameter :: c1lst(n) = (/(char(96+i)//'b',i=1,n)/)
logical :: tmp(n)
i = 5
print *, ilst(:) == i
print *, c0lst(:)(1:1) == char(96+i)
tmp = c1lst(:)(1:1) == char(96+i)
print *, tmp
print *, c1lst(:)(1:1) == 'e'
if (any(tmp .neqv. (c0lst(:)(1:1) == char(96+i)))) call abort()
end