浏览代码

* don't handle dynamic arrays using fpc_copy_proc(), because it
takes the address of its parameters and a dynamic array can
be in a register (e.g. as function result, mantis #10320)

git-svn-id: trunk@9381 -

Jonas Maebe 17 年之前
父节点
当前提交
154601b41d
共有 3 个文件被更改,包括 54 次插入1 次删除
  1. 1 0
      .gitattributes
  2. 2 1
      compiler/nld.pas
  3. 51 0
      tests/webtbs/tw10320.pp

+ 1 - 0
.gitattributes

@@ -7788,6 +7788,7 @@ tests/webtbs/tw1021.pp svneol=native#text/plain
 tests/webtbs/tw10210.pp svneol=native#text/plain
 tests/webtbs/tw10224.pp svneol=native#text/plain
 tests/webtbs/tw1023.pp svneol=native#text/plain
+tests/webtbs/tw10320.pp svneol=native#text/plain
 tests/webtbs/tw1041.pp svneol=native#text/plain
 tests/webtbs/tw1044.pp svneol=native#text/plain
 tests/webtbs/tw1046.pp svneol=native#text/plain

+ 2 - 1
compiler/nld.pas

@@ -599,7 +599,8 @@ implementation
          end
         { call helpers for composite types containing automated types }
         else if (left.resultdef.needs_inittable) and
-            (left.resultdef.typ in [arraydef,objectdef,recorddef]) then
+            (left.resultdef.typ in [arraydef,objectdef,recorddef]) and
+            not is_dynamic_array(left.resultdef) then
          begin
            hp:=ccallparanode.create(caddrnode.create_internal(
                   crttinode.create(tstoreddef(left.resultdef),initrtti,rdt_normal)),

+ 51 - 0
tests/webtbs/tw10320.pp

@@ -0,0 +1,51 @@
+program foo;
+
+{$mode DELPHI}
+
+type
+  TRgb = record
+    R,G,B : Byte;
+  end;
+  
+  TRgbArray = array of TRgb;
+  
+  TSomeClass = class
+    a: TRgbArray;
+    function GetP(Index : integer) : Pointer;
+    constructor create;
+  public
+    property P[Index: LongInt]: Pointer read GetP;
+  end;
+  
+var a : TRgbArray;
+    c : TSomeClass;
+
+constructor tsomeclass.create;
+begin
+  setlength(a,2);
+  a[0].r:=1;
+  a[0].g:=2;
+  a[0].b:=3;
+  a[1].r:=4;
+  a[1].g:=5;
+  a[1].b:=6;
+end;
+
+function TSomeClass.GetP(Index : integer) : Pointer;
+begin
+  result := pointer(a);
+end;
+    
+begin
+  c := TSomeClass.Create;
+  a := TRgbArray(c.P[1]); // Fatal: Internal error 2006111510
+  if (length(a)<>2) or
+     (a[0].r<>1) or
+     (a[0].g<>2) or
+     (a[0].b<>3) or
+     (a[1].r<>4) or
+     (a[1].g<>5) or
+     (a[1].b<>6) then
+    halt(1);
+  c.free;
+end.