Procházet zdrojové kódy

* fix #40062: ensure that Self is only added to anonymous functions when dealing with method pointers
+ added test

Sven/Sarah Barth před 2 roky
rodič
revize
4510945465
4 změnil soubory, kde provedl 68 přidání a 2 odebrání
  1. 3 0
      compiler/ncnv.pas
  2. 1 1
      compiler/pparautl.pas
  3. 2 1
      compiler/symconst.pas
  4. 62 0
      tests/webtbs/tw40062.pp

+ 3 - 0
compiler/ncnv.pas

@@ -2501,6 +2501,9 @@ implementation
                         ) then
                       internalerror(2021060801);
 
+                    { so that insert_self_and_vmt_para correctly inserts the
+                      Self, cause it otherwise skips that for anonymous functions }
+                    include(pd.procoptions,po_methodpointer);
                     { we know this only captures Self, so we can move the
                       anonymous function to normal function level }
                     pd.parast.symtablelevel:=normal_function_level;

+ 1 - 1
compiler/pparautl.pas

@@ -245,7 +245,7 @@ implementation
                 assigned(tprocdef(pd).struct) and
                 (
                   (pd.parast.symtablelevel=normal_function_level) or
-                  (po_anonymous in pd.procoptions)
+                  ([po_anonymous,po_methodpointer]<=pd.procoptions)
                 ) then
               begin
                 { static class methods have no hidden self/vmt pointer }

+ 2 - 1
compiler/symconst.pas

@@ -340,7 +340,8 @@ type
     po_finalmethod,       { Procedure is a final method }
     po_staticmethod,      { static method }
     po_overridingmethod,  { method with override directive }
-    po_methodpointer,     { method pointer, only in procvardef, also used for 'with object do' }
+    po_methodpointer,     { method pointer, only in procvardef, also used for 'with object do'
+                            and anonymous functions assigned to method pointers }
     po_interrupt,         { Procedure is an interrupt handler }
     po_iocheck,           { IO checking should be done after a call to the procedure }
     po_assembler,         { Procedure is written in assembler }

+ 62 - 0
tests/webtbs/tw40062.pp

@@ -0,0 +1,62 @@
+{ %NORUN }
+
+program tw40062;
+{$mode objfpc}{$H+}
+{$modeswitch AnonymousFunctions}
+{$modeswitch AdvancedRecords}
+
+uses
+        sysutils;
+
+type
+        TSomeRec = record
+                a: integer;
+                procedure print;
+                function text: string;
+                procedure something;
+                class procedure main; static;
+        end;
+
+function some_fun_0: TSomeRec;
+        begin
+                result.a := 4;
+        end;
+
+procedure TSomeRec.print;
+        begin
+                writeln('a = ', a);
+        end;
+
+function TSomeRec.text: string;
+        begin
+                result := format('a = %d', [a]);
+        end;
+
+procedure main;
+        begin
+                some_fun_0().print;
+                (function: TSomeRec begin result.a := 5 end()).print;
+                writeln((function: TSomeRec begin result.a := 10 end()).text);
+        end;
+
+procedure TSomeRec.something;
+        begin
+                (function: TSomeRec begin result.a := 5 end()).print;
+                writeln((function: TSomeRec begin result.a := 10 end()).text);
+        end;
+
+class procedure TSomeRec.main; static;
+        function primary: TSomeRec;
+                begin
+                        result.a := 20;
+                end;
+        begin
+                some_fun_0().print;
+                primary.something;
+        end;
+
+begin
+        main;
+        TSomeRec.main;
+end.
+