Jelajahi Sumber

* when forcing left into memory during code generation of a subscript node then the type of left must be passed else memory corruption happens

git-svn-id: trunk@22385 -
florian 13 tahun lalu
induk
melakukan
b72251389b
3 mengubah file dengan 50 tambahan dan 1 penghapusan
  1. 1 0
      .gitattributes
  2. 1 1
      compiler/ncgmem.pas
  3. 48 0
      tests/webtbs/tw22864.pp

+ 1 - 0
.gitattributes

@@ -12825,6 +12825,7 @@ tests/webtbs/tw22744.pp svneol=native#text/pascal
 tests/webtbs/tw2277.pp svneol=native#text/plain
 tests/webtbs/tw2280.pp svneol=native#text/plain
 tests/webtbs/tw22860.pp svneol=native#text/plain
+tests/webtbs/tw22864.pp svneol=native#text/pascal
 tests/webtbs/tw22869.pp svneol=native#text/plain
 tests/webtbs/tw2289.pp svneol=native#text/plain
 tests/webtbs/tw2291.pp svneol=native#text/plain

+ 1 - 1
compiler/ncgmem.pas

@@ -368,7 +368,7 @@ implementation
                    if not tstoreddef(left.resultdef).is_intregable or
                       not tstoreddef(resultdef).is_intregable or
                       (location.loc in [LOC_MMREGISTER,LOC_FPUREGISTER]) then
-                     hlcg.location_force_mem(current_asmdata.CurrAsmList,location,resultdef)
+                     hlcg.location_force_mem(current_asmdata.CurrAsmList,location,left.resultdef)
                    else
                      begin
                        if (left.location.loc = LOC_REGISTER) then

+ 48 - 0
tests/webtbs/tw22864.pp

@@ -0,0 +1,48 @@
+program testmethodpointer;
+
+{$mode objfpc}{$H+}
+
+type
+  TOnIdentifierFound = function(): integer of object;
+  TTest=class
+    OnIdentifierFound: TOnIdentifierFound;
+    FoundProc: pointer;
+    function testm():integer;
+  end;
+  TTest2=class
+    function testmm(Params:TTest;var c,d,e:integer):boolean;
+  end;
+
+function TTest.testm():integer;
+  begin
+
+  end;
+
+function TTest2.testmm(Params:TTest;var c,d,e:integer):boolean;
+var k,l:integer;
+
+  function testm2(Params1:TTest;var m,n:integer):boolean;
+  var a,b:integer;
+  begin
+    if (Params.OnIdentifierFound<>@Params.testm) then halt(1);
+    if (Params.FoundProc<>pointer($deadbeef)) then halt(1);
+  end;
+
+begin
+  testm2(Params,k,l);
+end;
+
+var
+  Test : TTest;
+  Test2 : TTest2;
+  c,d,e : integer;
+begin
+  Test:=TTest.Create;
+  Test.OnIdentifierFound:[email protected];
+  Test.FoundProc:=pointer($deadbeef);
+  Test2:=TTest2.Create;
+  Test2.testmm(Test,c,d,e);
+  Test.Free;
+  Test2.Free;
+  writeln('ok');
+end.