浏览代码

* fix check for openarray and single element

git-svn-id: trunk@4390 -
peter 19 年之前
父节点
当前提交
4bde345009
共有 3 个文件被更改,包括 38 次插入1 次删除
  1. 1 0
      .gitattributes
  2. 4 1
      compiler/defcmp.pas
  3. 33 0
      tests/webtbs/tw7227.pp

+ 1 - 0
.gitattributes

@@ -7239,6 +7239,7 @@ tests/webtbs/tw7104.pp svneol=native#text/plain
 tests/webtbs/tw7143.pp -text
 tests/webtbs/tw7143.pp -text
 tests/webtbs/tw7161.pp svneol=native#text/plain
 tests/webtbs/tw7161.pp svneol=native#text/plain
 tests/webtbs/tw7195.pp svneol=native#text/plain
 tests/webtbs/tw7195.pp svneol=native#text/plain
+tests/webtbs/tw7227.pp svneol=native#text/plain
 tests/webtbs/ub1873.pp svneol=native#text/plain
 tests/webtbs/ub1873.pp svneol=native#text/plain
 tests/webtbs/ub1883.pp svneol=native#text/plain
 tests/webtbs/ub1883.pp svneol=native#text/plain
 tests/webtbs/uw0555.pp svneol=native#text/plain
 tests/webtbs/uw0555.pp svneol=native#text/plain

+ 4 - 1
compiler/defcmp.pas

@@ -586,8 +586,11 @@ implementation
 
 
            arraydef :
            arraydef :
              begin
              begin
-             { open array is also compatible with a single element of its base type }
+               { open array is also compatible with a single element of its base type.
+                 the extra check for deftyp is needed because equal defs can also return
+                 true if the def types are not the same, for example with dynarray to pointer. }
                if is_open_array(def_to) and
                if is_open_array(def_to) and
+                  (def_to.deftype=tarraydef(def_to).elementtype.def.deftype) and
                   equal_defs(def_from,tarraydef(def_to).elementtype.def) then
                   equal_defs(def_from,tarraydef(def_to).elementtype.def) then
                 begin
                 begin
                   doconv:=tc_equal;
                   doconv:=tc_equal;

+ 33 - 0
tests/webtbs/tw7227.pp

@@ -0,0 +1,33 @@
+
+program openarray;
+{$ifdef fpc}{$mode delphi}{$endif}
+type
+ PDouble = ^Double;
+
+function CheckValues(values : array of PDouble) : boolean;
+var i : integer;
+begin
+ Result := True;
+ for i := Low(values) to High(values) do
+  if values[i]^ = 0 then
+    Result := False;
+end;
+
+var values : array of PDouble;
+    i : integer;
+begin
+ SetLength(values, 5);
+ for i := 0 to High(values) do
+ begin
+  New(values[i]);
+  values[i]^ := i+1;
+ end;
+
+ for i := 0 to High(values) do
+   writeln(values[i]^);
+
+ if CheckValues(values) then
+   WriteLn('OK')
+ else
+   writeln('not OK');
+end.