Browse Source

nested procvars: support assignments when switch not active

Support assigning one nested procvar to another even when the nestedprocvars
modeswitch is not active. This can happen when the type was declared in a
different unit that was compiled with this modeswitch, or in internally
generated wrapper code (which uses "pure" objfpc mode)
Jonas Maebe 1 year ago
parent
commit
2db4cae7aa
4 changed files with 98 additions and 1 deletions
  1. 2 1
      compiler/htypechk.pas
  2. 41 0
      tests/test/tnest6.pp
  3. 29 0
      tests/test/tnest6a.pp
  4. 26 0
      tests/test/unest6a.pp

+ 2 - 1
compiler/htypechk.pas

@@ -1197,7 +1197,8 @@ implementation
          if not(m_nested_procvars in current_settings.modeswitches) and
             (from_def.parast.symtablelevel>normal_function_level) and
             not (po_anonymous in from_def.procoptions) and
-            (to_def.typ=procvardef) then
+            (to_def.typ=procvardef) and
+            (tprocvardef(to_def).parast.symtablelevel <= normal_function_level) then
            CGMessage(type_e_cannot_local_proc_to_procvar);
       end;
 

+ 41 - 0
tests/test/tnest6.pp

@@ -0,0 +1,41 @@
+{$mode objfpc}
+{$modeswitch nestedprocvars}
+
+type
+  TNestedProc = procedure is nested;
+
+IInf = interface
+    procedure InfMethod(AParam: TNestedProc);
+end;
+
+TObj = class(TInterfacedObject, IInf)
+  procedure InfMethod(AParam: TNestedProc);
+end;
+
+const
+  ok: boolean = false;
+
+procedure TObj.InfMethod(AParam: TNestedProc);
+begin
+  aParam
+end;
+
+procedure test(const i: IInf);
+
+  procedure nest;
+    begin
+      ok:=true;
+    end;
+
+begin
+  i.InfMethod(@nest);
+end;
+
+var
+  i: IInf;
+begin
+  i:= tobj.create;
+  test(i);
+  i:=nil;
+  halt(ord(not ok));
+end.

+ 29 - 0
tests/test/tnest6a.pp

@@ -0,0 +1,29 @@
+{ %fail }
+
+{$mode objfpc}
+
+uses
+  unest6a;
+
+const
+  ok: boolean = false;
+
+procedure test(const i: IInf);
+
+  procedure nest;
+    begin
+      ok:=true;
+    end;
+
+begin
+  i.InfMethod(@nest);
+end;
+
+var
+  i: IInf;
+begin
+  i:= tobj.create;
+  test(i);
+  i:=nil;
+  halt(ord(not ok));
+end.

+ 26 - 0
tests/test/unest6a.pp

@@ -0,0 +1,26 @@
+{$mode objfpc}
+{$modeswitch nestedprocvars}
+
+unit unest6a;
+
+interface
+
+type
+  TNestedProc = procedure is nested;
+
+IInf = interface
+    procedure InfMethod(AParam: TNestedProc);
+end;
+
+TObj = class(TInterfacedObject, IInf)
+  procedure InfMethod(AParam: TNestedProc);
+end;
+
+implementation
+
+procedure TObj.InfMethod(AParam: TNestedProc);
+begin
+  aParam
+end;
+
+end.