Pārlūkot izejas kodu

* do not require exactly the same range type for indexed properties
referring to an array field, but instead simply convert the index
to the array range type (mantis #8810)

git-svn-id: trunk@7260 -

Jonas Maebe 18 gadi atpakaļ
vecāks
revīzija
63f80f3472
3 mainītis faili ar 42 papildinājumiem un 4 dzēšanām
  1. 1 0
      .gitattributes
  2. 3 4
      compiler/pdecvar.pas
  3. 38 0
      tests/webtbs/tw8810.pp

+ 1 - 0
.gitattributes

@@ -8187,6 +8187,7 @@ tests/webtbs/tw8757.pp svneol=native#text/plain
 tests/webtbs/tw8777f.pp svneol=native#text/plain
 tests/webtbs/tw8777g.pp svneol=native#text/plain
 tests/webtbs/tw8777i.pp svneol=native#text/plain
+tests/webtbs/tw8810.pp svneol=native#text/plain
 tests/webtbs/ub1873.pp svneol=native#text/plain
 tests/webtbs/ub1883.pp svneol=native#text/plain
 tests/webtbs/uw0555.pp svneol=native#text/plain

+ 3 - 4
compiler/pdecvar.pas

@@ -176,10 +176,9 @@ implementation
                              begin
                                if (p.nodetype=ordconstn) then
                                  begin
-                                   if compare_defs(p.resultdef,tarraydef(def).rangedef,nothingn)>=te_equal then
-                                     idx:=tordconstnode(p).value
-                                   else
-                                     IncompatibleTypes(p.resultdef,tarraydef(def).rangedef);
+                                   { type/range checking }
+                                   inserttypeconv(p,tarraydef(def).rangedef);
+                                   idx:=tordconstnode(p).value
                                  end
                                else
                                 Message(type_e_ordinal_expr_expected)

+ 38 - 0
tests/webtbs/tw8810.pp

@@ -0,0 +1,38 @@
+{$ifdef fpc}
+{$mode delphi}
+{$endif}
+
+{$r+}
+
+CONST MaxBitmaps=129;
+
+TYPE  tbitmap = longint;
+      TBack =CLASS
+                 constructor create;
+                 PRIVATE
+                   FBitmaps :ARRAY [0..MaxBitmaps] OF TBitmap;
+
+                 PUBLIC
+                   PROPERTY Bitmap :TBitmap READ FBitmaps[0];
+                   PROPERTY LightBitmap :TBitmap READ FBitmaps[1];
+                   PROPERTY ShadowBitmap:TBitmap READ FBitmaps[2];
+            end;
+
+constructor tback.create;
+var
+  i: longint;
+begin
+  for i := low(fbitmaps) to high(fbitmaps) do
+    fbitmaps[i] := i;
+end;
+
+var
+  b: tback;
+begin
+  b:=tback.create;
+  if (b.Bitmap <> 0) or
+     (b.LightBitmap <> 1) or
+     (b.ShadowBitmap <> 2) then
+    halt(1);
+  b.free;
+end.