Loosen “Local procedure/function assigned to procedure variable” restriction gracefully

Question

Consider the following test-case:

{ CompilerVersion = 21 }
procedure Global();

  procedure Local();
  begin
  end;

type
  TProcedure = procedure ();
var
           


        

Answer 1

For the records, my homebrewn closure:

{ this type looks "leaked" }
type TFunction = function (): Integer;

function MyFunction(): TFunction;

  {$J+ move it outside the stack segment!}
  const Answer: Integer = 42;

  function Local(): Integer;
  begin
    Result := Answer;
    { just some side effect }
    Answer := Answer + Answer div 2;
  end;

begin
  Result := @Local;
end;


procedure TForm1.FormClick(Sender: TObject);
var
  Func: TFunction;
  N: Integer;
begin
  { unfolded for clarity }
  Func := MyFunction();
  N := Func();
  ShowMessageFmt('Answer: %d', [N]);
end;

Answer 2

Here's why you can't do it:

type
  TProcedure = procedure ();

function Global(): TProcedure;
var
  localint: integer;

  procedure Local();
  begin
    localint := localint + 5;
  end;

begin
  result := Local;
end;

Local procedures have access to the outer routine's variable scope. Those variables are declared on the stack, though, and become invalid once the outer procedure returns.

However, if you're using CompilerVersion 21 (Delphi 2010), you've got anonymous methods available, which should be able to do what you're looking for; you just need a slightly different syntax.

Answer 3

Your best bet is to declare it as reference to procedure using the new anonymous methods feature and then you can keep everything nicely encapsulated.

type
  TProc = reference to procedure;

procedure Outer;
var
  Local: TProc;
begin
  Local := procedure
    begin
      DoStuff;
    end;
  Local;
end;

This gets around the issues that Mason describes by capturing any variables local to the anonymous function.

Answer 4

If one really needs to use local procedures in D7 or earlier one could use this trick:

procedure GlobalProc;
var t,maxx:integer; itr,flag1,flag2:boolean; iterat10n:pointer;
    //Local procs:
    procedure iterat10n_01;begin {code #1 here} end;
    procedure iterat10n_10;begin {code #2 here} end;
    procedure iterat10n_11;begin {code #1+#2 here} end;
begin
    //...
    t:=ord(flag2)*$10 or ord(flag1);
    if t=$11 then iterat10n:=@iterat10n_11
      else if t=$10 then iterat10n:=@iterat10n_10
        else if t=$01 then iterat10n:=@iterat10n_01
          else iterat10n:=nil;
    itr:=(iterat10n<>nil);
    //...
    for t:=1 to maxx do begin
        //...
        if(itr)then asm
            push ebp;
            call iterat10n;
            pop ecx;
        end;
        //...
    end;
    //...
end;

However the problem is that adress-registers could differ on different machines - so it's needed to write some code using local proc call and look via breakpoint which registers are used there...

And yeah - in most real production cases this trick is just some kind of palliative.