toolchain/gcc/3.4.2/300-pr17541.patch

   1 # DP: 2004-09-21  Bud Davis  <bdavis9659@comcast.net>
   2 # DP:
   3 # DP:   PR fortran/17541
   4 # DP:   * bld.c (ffebld_constant_new_real2_val): Fix typo,
   5 # DP:
   6 # DP:   PR fortran/17541
   7 # DP:   * g77.f-torture/execute/pr17541.f: New test.
   8
   9 Index: gcc/gcc/f/bld.c
  10 ===================================================================
  11 RCS file: /cvs/gcc/gcc/gcc/f/Attic/bld.c,v
  12 retrieving revision 1.16.14.1
  13 retrieving revision 1.16.14.2
  14 diff -u -r1.16.14.1 -r1.16.14.2
  15 --- gcc/gcc/f/bld.c     12 Jul 2004 17:58:36 -0000      1.16.14.1
  16 +++ gcc/gcc/f/bld.c     21 Sep 2004 12:54:27 -0000      1.16.14.2
  17 @@ -1333,7 +1333,7 @@
  18       nc = malloc_new_kp (ffebld_constant_pool(),
  19                           "FFEBLD_constREAL2",
  20                           sizeof (*nc));
  21 -     nc->consttype = FFEBLD_constREAL1;
  22 +     nc->consttype = FFEBLD_constREAL2;
  23       nc->u.real2 = val;
  24       nc->hook = FFECOM_constantNULL;
  25       nc->llink = NULL;
  26 Index: gcc/gcc/testsuite/g77.f-torture/execute/pr17541.f
  27 ===================================================================
  28 RCS file: gcc/gcc/testsuite/g77.f-torture/execute/pr17541.f
  29 diff -N gcc/gcc/testsuite/g77.f-torture/execute/pr17541.f
  30 --- /dev/null   1 Jan 1970 00:00:00 -0000
  31 +++ gcc/gcc/testsuite/g77.f-torture/execute/pr17541.f   21 Sep 2004 12:54:35 -0000      1.1.2.1
  32 @@ -0,0 +1,202 @@
  33 +        program test
  34 +        implicit none
  35 +! check all types of data statements
  36 +! pr 17541
  37 +        real r(2)
  38 +        double precision s(2)
  39 +        integer*1 ib(2)
  40 +        integer*2 ih(2)
  41 +        integer*4 iw(2)
  42 +        integer*8 id(3)
  43 +        logical*1 lb(2)
  44 +        logical*2 lh(2)
  45 +        logical*4 lw(2)
  46 +        logical*8 ld(2)
  47 +        character*1 a(2)
  48 +        character*5 b(2)
  49 +        complex c1(2)
  50 +        complex*8 c2(2)
  51 +        data r / 1.0,2.0 /
  52 +        data s / 2.d0,1.d0/
  53 +        data ib / 1,-1 /
  54 +        data ih / 2,100/
  55 +        data iw / 4,3560000 /
  56 +        data id / 8,Z'ABCDEF01',Z'5555AAAA' /
  57 +        data a / 'a', 'z' /
  58 +        data b / 'xyz','abc'/
  59 +        data c1 /(1.0,2.0),(-1.0,-2.0)/
  60 +        data c2 /(1.d0,2.d0),(-1.d0,-2.d0)/
  61 +        data lb / .TRUE.,.FALSE. /
  62 +        data lh / .TRUE.,.FALSE. /
  63 +        data lw / .TRUE.,.FALSE. /
  64 +        data ld / .TRUE.,.FALSE. /
  65 +        logical dbug
  66 +        data dbug /.FALSE./
  67 +! check the reals first
  68 +        if (r(1).ne.1.0) then
  69 +           if (dbug) then
  70 +             print*,r(1), ' should be 1.0 '
  71 +           else
  72 +             call abort
  73 +           endif
  74 +        endif
  75 +        if (r(2).ne.2.0) then
  76 +           if (dbug) then
  77 +             print*,r(2), ' should be 2.0 '
  78 +           else
  79 +             call abort
  80 +           endif
  81 +        endif
  82 +        if (s(1).ne.2.d0) then
  83 +           if (dbug) then
  84 +             print*,s(1), ' xxshould be 2.d0 '
  85 +           else
  86 +             call abort
  87 +           endif
  88 +        endif
  89 +        if (s(2).ne.1.d0) then
  90 +           if (dbug) then
  91 +             print*,s(2), ' should be 1.d0 '
  92 +           else
  93 +             call abort
  94 +           endif
  95 +        endif
  96 +! now the integers
  97 +        if (ib(1).ne.1) then
  98 +           if (dbug) then
  99 +             print*,ib(1), ' should be 1 '
 100 +           else
 101 +             call abort
 102 +           endif
 103 +        endif
 104 +        if (ib(2).ne.-1) then
 105 +           if (dbug) then
 106 +             print*,ib(2), ' should be -1 '
 107 +           else
 108 +             call abort
 109 +           endif
 110 +        endif
 111 +        if (ih(1).ne.2) then
 112 +           if (dbug) then
 113 +             print*,ih(2), ' should be 2 '
 114 +           else
 115 +             call abort
 116 +           endif
 117 +        endif
 118 +        if (ih(2).ne.100) then
 119 +           if (dbug) then
 120 +             print*,ih(2), ' should be 100 '
 121 +           else
 122 +             call abort
 123 +           endif
 124 +        endif
 125 +        if (iw(1).ne.4) then
 126 +           if (dbug) then
 127 +             print*,iw(1), ' should be 4 '
 128 +           else
 129 +             call abort
 130 +           endif
 131 +        endif
 132 +        if (iw(2).ne.3560000) then
 133 +           if (dbug) then
 134 +             print*,iw(2), ' should be 3560000 '
 135 +           else
 136 +             call abort
 137 +           endif
 138 +        endif
 139 +        if (id(1).ne.8) then
 140 +           if (dbug) print*,id(1), ' should be 8 '
 141 +           call abort
 142 +        endif
 143 +        if (id(2).ne.Z'ABCDEF01') then
 144 +           if (dbug) print*,id(2), " should be Z'ABCDEF01' "
 145 +           call abort
 146 +        endif
 147 +        if (id(3).ne.Z'5555AAAA') then
 148 +           if (dbug) print*,id(2), " should be Z'5555AAAA' "
 149 +           call abort
 150 +        endif
 151 +! complex
 152 +        if (c1(1).ne.(1.0,2.0)) then
 153 +           if (dbug) then
 154 +             print*,c1(1), ' should be (1.0,2.0) '
 155 +           else
 156 +             call abort
 157 +           endif
 158 +        endif
 159 +        if (c1(2).ne.(-1.0,-2.0)) then
 160 +           if (dbug) then
 161 +             print*,c1(2), ' should be (-1.0,-2.0) '
 162 +           else
 163 +             call abort
 164 +           endif
 165 +        endif
 166 +        if (c2(1).ne.(1.d0,2.d0)) then
 167 +           if (dbug) then
 168 +             print*,c2(1), ' should be (1.0,2.0) '
 169 +           else
 170 +             call abort
 171 +           endif
 172 +        endif
 173 +        if (c2(2).ne.(-1.d0,-2.d0)) then
 174 +           if (dbug) then
 175 +             print*,c2(2), ' should be (-1.0,-2.0) '
 176 +           else
 177 +             call abort
 178 +           endif
 179 +        endif
 180 +! character
 181 +        if (a(1).ne.'a') then
 182 +           if (dbug) then
 183 +             print*,a(1), ' should be a '
 184 +           else
 185 +             call abort
 186 +           endif
 187 +        endif
 188 +        if (b(1).ne.'xyz') then
 189 +           if (dbug) then
 190 +             print*,b(1), ' should be xyz '
 191 +           else
 192 +             call abort
 193 +           endif
 194 +        endif
 195 +!logicals
 196 +        if (.NOT.lb(1)) then
 197 +           if (dbug) print*,lb(1), ' should be .T. '
 198 +           call abort
 199 +        endif
 200 +        if (lb(2)) then
 201 +           if (dbug) print*,lb(2), ' should be .F. '
 202 +           call abort
 203 +        endif
 204 +        if (.NOT.lh(1)) then
 205 +           if (dbug) print*,lh(1), ' should be .T. '
 206 +           call abort
 207 +        endif
 208 +        if (lh(2)) then
 209 +           if (dbug) print*,lh(2), ' should be .F. '
 210 +           call abort
 211 +        endif
 212 +        if (.NOT.lw(1)) then
 213 +           if (dbug) print*,lw(1), ' should be .T. '
 214 +           call abort
 215 +        endif
 216 +        if (lw(2)) then
 217 +           if (dbug) print*,lw(2), ' should be .F. '
 218 +           call abort
 219 +        endif
 220 +        if (.NOT.ld(1)) then
 221 +           if (dbug) then
 222 +             print*,ld(1), ' should be .T. '
 223 +           else
 224 +             call abort
 225 +           endif
 226 +        endif
 227 +        if (ld(2)) then
 228 +           if (dbug) then
 229 +             print*,ld(2), ' should be .F. '
 230 +           else
 231 +             call abort
 232 +           endif
 233 +        endif
 234 +        end