* Fix for Mantis #38122: when a deref node is passed as a Self parameter for a type helper (which is a var parameter) we need to pass the non-derefentiated value so that the data it points to can be modified by the helper's method (this is Delphi compatible)

+ added tests

git-svn-id: trunk@47625 -

.gitattributes

@@ -15833,6 +15833,7 @@ tests/test/tthlp26b.pp -text svneol=native#text/pascal
 tests/test/tthlp26c.pp -text svneol=native#text/pascal
 tests/test/tthlp27.pp svneol=native#text/pascal
 tests/test/tthlp28.pp svneol=native#text/pascal
+tests/test/tthlp29.pp svneol=native#text/pascal
 tests/test/tthlp3.pp svneol=native#text/pascal
 tests/test/tthlp4.pp svneol=native#text/pascal
 tests/test/tthlp5.pp svneol=native#text/pascal
@@ -18589,6 +18590,7 @@ tests/webtbs/tw38058.pp svneol=native#text/pascal
 tests/webtbs/tw38069.pp svneol=native#text/pascal
 tests/webtbs/tw38074.pp svneol=native#text/pascal
 tests/webtbs/tw38083.pp svneol=native#text/pascal
+tests/webtbs/tw38122.pp svneol=native#text/pascal
 tests/webtbs/tw3814.pp svneol=native#text/plain
 tests/webtbs/tw3827.pp svneol=native#text/plain
 tests/webtbs/tw3829.pp svneol=native#text/plain

compiler/ncal.pas

@@ -3578,7 +3578,7 @@ implementation
       var
         candidates : tcallcandidates;
         oldcallnode : tcallnode;
-        hpt : tnode;
+        hpt,tmp : tnode;
         pt : tcallparanode;
         lastpara : longint;
         paraidx,
@@ -4004,6 +4004,19 @@ implementation
                    e.g. class reference types account }
                  hpt:=actualtargetnode(@hpt)^;
 
+                 { if the value a type helper works on is a derefentiation we need to
+                   pass the original pointer as Self as the Self value might be
+                   changed by the helper }
+                 if is_objectpascal_helper(tdef(procdefinition.owner.defowner)) and
+                    not is_implicit_pointer_object_type(tobjectdef(procdefinition.owner.defowner).extendeddef) and
+                    (hpt.nodetype=derefn) then
+                   begin
+                     tmp:=tderefnode(hpt).left;
+                     tderefnode(hpt).left:=nil;
+                     methodpointer.free;
+                     methodpointer:=tmp;
+                   end;
+
                  { R.Init then R will be initialized by the constructor,
                    Also allow it for simple loads }
                  if (procdefinition.proctypeoption=potype_constructor) or

tests/test/tthlp29.pp

@@ -0,0 +1,76 @@
+program tthlp29;
+
+{$mode objfpc}
+{$modeswitch typehelpers}
+{$APPTYPE CONSOLE}
+
+type
+  TLongIntHelper = type helper for LongInt
+    procedure Test;
+  end;
+
+procedure TLongIntHelper.Test;
+begin
+  Self := Self + 10;
+end;
+
+var
+  l: LongInt;
+  pl: PLongInt;
+  pul: PLongWord;
+  pb: PByte;
+
+function GetPL: PLongInt;
+begin
+  Result := @l;
+end;
+
+function GetPUL: PLongWord;
+begin
+  Result := @l;
+end;
+
+function GetPB: PByte;
+begin
+  Result := @l;
+end;
+
+begin
+  l := 0;
+  pl := @l;
+  pul := @l;
+  pb := @l;
+  Writeln(l);
+  l.Test;
+  Writeln(l);
+  if l <> 10 then
+    Halt(1);
+  pl^.Test;
+  Writeln(l);
+  if l <> 20 then
+    Halt(2);
+  GetPL^.Test;
+  Writeln(l);
+  if l <> 30 then
+    Halt(3);
+  { type conversions with the same size are ignored }
+  LongInt(pul^).Test;
+  Writeln(l);
+  if l <> 40 then
+    Halt(4);
+  LongInt(GetPUL^).Test;
+  Writeln(l);
+  if l <> 50 then
+    Halt(5);
+  { type conversions with different sizes operate on a tmp }
+  LongInt(pb^).Test;
+  Writeln(l);
+  if l <> 50 then
+    Halt(6);
+  LongInt(GetPB^).Test;
+  Writeln(l);
+  if l <> 50 then
+    Halt(7);
+  Writeln('ok');
+end.
+

tests/webtbs/tw38122.pp

@@ -0,0 +1,81 @@
+program tw38122;
+
+{$mode objfpc}
+{$modeswitch advancedrecords}
+{$modeswitch typehelpers}
+
+uses
+  Math;
+
+type float = double;
+     pfloat = ^float;
+
+type  TFloatHelper = type helper for float
+        procedure sub (const a: float);
+      end;
+
+type TMatrix = record
+                 sx,sy: sizeint;
+                 procedure Init (x,y: sizeint; content: array of float);
+                 function GetAdr (x,y: sizeint): pfloat;
+                 procedure print;
+                 private
+                   data: array of float;
+               end;
+
+procedure TFloatHelper.sub (const a: float);
+begin
+  self := self-a;
+end;
+
+function TMatrix.GetAdr (x,y: sizeint): pfloat;
+begin
+  result := @data[x*sy+y];
+end;
+
+procedure TMatrix.Init (x,y: sizeint; content: array of float);
+var i: sizeint;
+begin
+  sx :=x;
+  sy :=y;
+  Data := nil;
+  SetLength (data, sx*sy);
+  for i := 0 to sx*sy-1 do data[i] := content[i];
+end;
+
+procedure TMatrix.print;
+var x,y: sizeint;
+begin
+  for y := 0 to sy-1 do begin
+    writeln;
+    for x := 0 to sx-1 do begin
+      write (GetAdr(x,y)^:2:2,'  ');
+    end;
+  end;
+  writeln;
+end;
+
+var A: TMatrix;
+    px: pfloat;
+begin
+  A.Init (2,2,[1,2,3,4]);
+  A.print;
+  if not SameValue(A.data[3],4,1e-1) then
+    Halt(1);
+
+  A.GetAdr(1,1)^ := 0; //I can set an element like this...
+  A.Print;
+  if not SameValue(A.data[3],0,1e-1) then
+    Halt(2);
+
+  px := A.GetAdr(1,1);
+  px^.sub(100);  //and this works as well.
+  A.Print;
+  if not SameValue(A.data[3],-100,1e-1) then
+    Halt(3);
+
+  A.GetAdr(1,1)^.sub(1000); //but that does not change the Matrix !?!
+  A.print;
+  if not SameValue(A.data[3],-1100,1e-1) then
+    Halt(4);
+end.