* fix #40061: the Self of types that aren't implicit pointers (recods, TP-style objects, primitive types (for helpers)) needs to be stored as a Pointer in the Capturer so that modifications are correctly visible

+ added tests

compiler/procdefutil.pas

@@ -574,6 +574,7 @@ implementation
       sym : tsym;
       fieldsym : tfieldvarsym;
       fieldname : tsymstr;
+      fielddef : tdef;
     begin
       if not pd.was_anonymous or not assigned(pd.capturedsyms) or (pd.capturedsyms.count=0) then
         exit;
@@ -611,9 +612,14 @@ implementation
                   if not assigned(fieldsym) then
                     begin
                       {$ifdef DEBUG_CAPTURER}writeln('Adding field ',fieldname,' to ',subcapturer.typesym.name);{$endif}
+                      fielddef:=tabstractvarsym(sym).vardef;
                       if vo_is_self in tabstractnormalvarsym(sym).varoptions then
-                        fieldname:='$'+fieldname;
-                      fieldsym:=cfieldvarsym.create(fieldname,vs_value,tabstractvarsym(sym).vardef,[]);
+                        begin
+                          fieldname:='$'+fieldname;
+                          if not is_implicit_pointer_object_type(fielddef) then
+                            fielddef:=cpointerdef.getreusable(fielddef);
+                        end;
+                      fieldsym:=cfieldvarsym.create(fieldname,vs_value,fielddef,[]);
                       fieldsym.fileinfo:=sym.fileinfo;
                       subcapturer.symtable.insertsym(fieldsym);
                       tabstractrecordsymtable(subcapturer.symtable).addfield(fieldsym,vis_public);
@@ -1314,6 +1320,8 @@ implementation
           n:=cloadnode.create(psym,psym.owner);
           if psym.capture_sym.owner.defowner<>capturer.vardef then
             internalerror(2022010903);
+          if (vo_is_self in psym.varoptions) and not is_implicit_pointer_object_type(psym.vardef) then
+            n:=caddrnode.create(n);
           n:=cassignmentnode.create(
                csubscriptnode.create(psym.capture_sym,cloadnode.create(capturer,capturer.owner)),
                n
@@ -1455,6 +1463,10 @@ implementation
           n:=csubscriptnode.create(mapping^.newsym,mapping^.selfnode.getcopy);
           if loadprocvar then
             include(n.flags,nf_load_procvar);
+          if (mapping^.oldsym.typ=paravarsym) and
+              (vo_is_self in tparavarsym(mapping^.oldsym).varoptions) and
+              not is_implicit_pointer_object_type(tparavarsym(mapping^.oldsym).vardef) then
+            n:=cderefnode.create(n);
           typecheckpass(n);
           current_filepos:=old_filepos;
           break;

tests/test/tanonfunc71.pp

@@ -0,0 +1,41 @@
+program tanonfunc71;
+
+{$mode objfpc}
+{$modeswitch advancedrecords}
+{$modeswitch anonymousfunctions}
+{$modeswitch functionreferences}
+
+type
+  TTest = record
+    f: LongInt;
+    procedure Test;
+  end;
+
+  TProc = reference to procedure;
+
+procedure TTest.Test;
+
+  procedure Foobar(aArg: TProc);
+  begin
+    aArg();
+  end;
+
+begin
+  Writeln('Before Nested: ', f);
+  Foobar(procedure begin
+    Writeln('Before Inc: ', f);
+    Inc(f);
+    Writeln('After Inc: ', f);
+  end);
+  Writeln('After Nested: ', f);
+end;
+
+var
+  t: TTest;
+begin
+  t.f := 42;
+  t.Test;
+  Writeln('After Test: ', t.f);
+  if t.f <> 43 then
+    Halt(1);
+end.

tests/test/tanonfunc72.pp

@@ -0,0 +1,41 @@
+program tanonfunc72;
+
+{$mode objfpc}
+{$modeswitch advancedrecords}
+{$modeswitch anonymousfunctions}
+{$modeswitch functionreferences}
+{$modeswitch typehelpers}
+
+type
+  TTest = type helper for LongInt
+    procedure Test;
+  end;
+
+  TProc = reference to procedure;
+
+procedure TTest.Test;
+
+  procedure Foobar(aArg: TProc);
+  begin
+    aArg();
+  end;
+
+begin
+  Writeln('Before Nested: ', Self);
+  Foobar(procedure begin
+    Writeln('Before Inc: ', Self);
+    Inc(Self);
+    Writeln('After Inc: ', Self);
+  end);
+  Writeln('After Nested: ', Self);
+end;
+
+var
+  l: LongInt;
+begin
+  l := 42;
+  l.Test;
+  Writeln('After Test: ', l);
+  if l <> 43 then
+    Halt(1);
+end.

tests/webtbs/tw40061.pp

@@ -0,0 +1,106 @@
+{$mode objfpc}{$H+}
+{$modeswitch AnonymousFunctions}
+{$modeswitch FunctionReferences}
+{$modeswitch AdvancedRecords}
+{$COperators On}
+
+program tw40061;
+
+uses
+        sysutils;
+
+type
+        prtype1int = reference to procedure(i: integer);
+        TSomeRec = record
+        strict private
+                a: integer;
+                b: integer;
+                procedure update;
+                procedure update10;
+                procedure update20;
+        public
+                class procedure main10; static;
+                class procedure main20; static;
+        end;
+
+procedure TSomeRec.update;
+        procedure primary(i: integer = 0);
+                begin
+                        for i := 0 to b do inc(a);
+                end;
+        begin
+                primary;
+        end;
+
+procedure TSomeRec.update10;
+        procedure primary(i: integer = 0);
+                begin
+                        for i := 1 to b do inc(a);
+                        writeln('update10 a = ', a);
+                end;
+        begin
+                update;
+                b += 4;
+                primary;
+        end;
+
+procedure TSomeRec.update20;
+        procedure primary(const f: prtype1int);
+                begin
+                        f(0);
+                end;
+        begin
+                writeln('update20.0 a = ', a, ' b = ', b);
+                update;
+                b += 4;
+                writeln('update20.1 a = ', a, ' b = ', b);
+                primary(procedure (i: integer)
+                begin
+                        writeln('update20.2 a = ', a, ' b = ', b);
+                        for i := 1 to b do inc(a);
+                        writeln('update20.3 a = ', a, ' b = ', b);
+                end);
+        end;
+
+class procedure TSomeRec.main10; static;
+        function primary: TSomeRec;
+                begin
+                        result.a := 0;
+                        result.b := 10;
+                        result.update10;
+                end;
+        begin
+                writeln(format('main10 a = %d', [primary.a]));
+        end;
+
+class procedure TSomeRec.main20; static;
+        function primary: TSomeRec;
+                begin
+                        result.a := 0;
+                        result.b := 10;
+                        result.update20;
+                        if result.a <> 25 then
+                          halt(1);
+                end;
+        begin
+                writeln(format('main20 a = %d', [primary.a]));
+        end;
+
+procedure primary(const n: integer=0; i: integer=0; a: integer=0);
+        begin
+                writeln('primary a = ', a);
+                for i := 1 to n do procedure begin a += 1; end();
+                writeln('primary a = ', a);
+        end;
+
+procedure main;
+        begin
+                //TSomeRec.main10;
+                TSomeRec.main20;
+                //primary(10);
+        end;
+
+begin
+        main;
+end.
+