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

Reply via email to