When compiled with gfortran 4.3.1/4.4.0, the following code:
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 '(55L)', exprs(:)(1:1)=='a'
print '(55L)', tmp(:,i)
end do
end
gives
FFFTTTFFFFFFFFFTFFFFFFFFFFFFFFFFFFFFFFTFFFFFFTFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
The first line is the expected result, the second one is wrong.
See http://gcc.gnu.org/ml/fortran/2008-08/msg00057.html for the original post.
the dump original gives:
pack_bug ()
{
extern character(kind=1) al[1:26];
integer(kind=4) i;
extern logical(kind=4) tmp[1430];
static integer(kind=4) options.0[7] = {68, 127, 0, 0, 0, 1, 0};
_gfortran_set_options (7, (void *) &options.0);
i = 1;
if (i <= 1)
{
while (1)
{
{
logical(kind=4) D.1013;
{
integer(kind=4) D.992;
static character(kind=1)[1:8] * A.1[55] = {&"n"[1]{lb: 1 sz: 1},
&"l"[1]{lb: 1 sz: 1}, &"s"[1]{lb: 1 sz: 1}, &"a"[1]{lb: 1 sz: 1}, &"a"[1]{lb: 1
sz: 1}, &"a"[1]{lb: 1 sz: 1}, &"c"[1]{lb: 1 sz: 1}, &"s"[1]{lb: 1 sz: 1},
&"t"[1]{lb: 1 sz: 1}, &"i"[1]{lb: 1 sz: 1}, &"c"[1]{lb: 1 sz: 1}, &"s"[1]{lb: 1
sz: 1}, &"t"[1]{lb: 1 sz: 1}, &"e"[1]{lb: 1 sz: 1}, &"l"[1]{lb: 1 sz: 1},
&"a"[1]{lb: 1 sz: 1}, &"d"[1]{lb: 1 sz: 1}, &"s"[1]{lb: 1 sz: 1}, &"r"[1]{lb: 1
sz: 1}, &"m"[1]{lb: 1 sz: 1}, &"m"[1]{lb: 1 sz: 1}, &"b"[1]{lb: 1 sz: 1},
&"b"[1]{lb: 1 sz: 1}, &"b"[1]{lb: 1 sz: 1}, &"b"[1]{lb: 1 sz: 1}, &"b"[1]{lb: 1
sz: 1}, &"b"[1]{lb: 1 sz: 1}, &"l"[1]{lb: 1 sz: 1}, &"e"[1]{lb: 1 sz: 1},
&"e"[1]{lb: 1 sz: 1}, &"l"[1]{lb: 1 sz: 1}, &"g"[1]{lb: 1 sz: 1}, &"c"[1]{lb: 1
sz: 1}, &"s"[1]{lb: 1 sz: 1}, &"c"[1]{lb: 1 sz: 1}, &"l"[1]{lb: 1 sz: 1},
&"g"[1]{lb: 1 sz: 1}, &"s"[1]{lb: 1 sz: 1}, &"a"[1]{lb: 1 sz: 1}, &"m"[1]{lb: 1
sz: 1}, &"n"[1]{lb: 1 sz: 1}, &"r"[1]{lb: 1 sz: 1}, &"f"[1]{lb: 1 sz: 1},
&"f"[1]{lb: 1 sz: 1}, &"u"[1]{lb: 1 sz: 1}, &"a"[1]{lb: 1 sz: 1}, &"s"[1]{lb: 1
sz: 1}, &"c"[1]{lb: 1 sz: 1}, &"f"[1]{lb: 1 sz: 1}, &"s"[1]{lb: 1 sz: 1},
&"b"[1]{lb: 1 sz: 1}, &"b"[1]{lb: 1 sz: 1}, &"b"[1]{lb: 1 sz: 1}, &"b"[1]{lb: 1
sz: 1}, &"b"[1]{lb: 1 sz: 1}};
D.992 = i;
{
integer(kind=4) D.994;
integer(kind=4) S.2;
D.994 = D.992 * 55 + -56;
S.2 = 1;
while (1)
{
if (S.2 > 55) goto L.3;
tmp[S.2 + D.994] = _gfortran_compare_string (8, A.1[S.2 +
-1], 1, (character(kind=1)[1:26] *) &al[i]{lb: 1 sz: 1}) == 0;
S.2 = S.2 + 1;
}
L.3:;
}
}
{
struct __st_parameter_dt dt_parm.3;
dt_parm.3.common.filename = &"pack_bug_red.f90"[1]{lb: 1 sz: 1};
dt_parm.3.common.line = 22;
dt_parm.3.format = &"(55L)"[1]{lb: 1 sz: 1};
dt_parm.3.format_len = 5;
dt_parm.3.common.flags = 4096;
dt_parm.3.common.unit = 6;
_gfortran_st_write (&dt_parm.3);
{
static logical(kind=4) A.4[55] = {0, 0, 0, 1, 1, 1, 0, 0, 0, 0,
0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0};
{
integer(kind=4) S.5;
S.5 = 0;
while (1)
{
if (S.5 > 54) goto L.4;
{
logical(kind=4) D.999;
D.999 = A.4[S.5];
_gfortran_transfer_logical (&dt_parm.3, &D.999, 4);
}
S.5 = S.5 + 1;
}
L.4:;
}
}
_gfortran_st_write_done (&dt_parm.3);
}
{
struct __st_parameter_dt dt_parm.6;
dt_parm.6.common.filename = &"pack_bug_red.f90"[1]{lb: 1 sz: 1};
dt_parm.6.common.line = 23;
dt_parm.6.format = &"(55L)"[1]{lb: 1 sz: 1};
dt_parm.6.format_len = 5;
dt_parm.6.common.flags = 4096;
dt_parm.6.common.unit = 6;
_gfortran_st_write (&dt_parm.6);
{
struct array1_logical(kind=4) parm.7;
integer(kind=4) D.1002;
D.1002 = i;
parm.7.dtype = 273;
parm.7.dim[0].lbound = 1;
parm.7.dim[0].ubound = 55;
parm.7.dim[0].stride = 1;
parm.7.data = (void *) &tmp[D.1002 * 55 + -55];
parm.7.offset = -56;
_gfortran_transfer_array (&dt_parm.6, &parm.7, 4, 0);
}
_gfortran_st_write_done (&dt_parm.6);
}
L.1:;
D.1013 = i == 1;
i = i + 1;
if (D.1013) goto L.2;
}
}
}
L.2:;
}
--
Summary: Wrong results when comparing a character array to a
character expression
Product: gcc
Version: 4.4.0
Status: UNCONFIRMED
Severity: normal
Priority: P3
Component: fortran
AssignedTo: unassigned at gcc dot gnu dot org
ReportedBy: dominiq at lps dot ens dot fr
http://gcc.gnu.org/bugzilla/show_bug.cgi?id=37099
