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
  Proc: TProcedure;
begin
  Proc := Local;  { E2094 Local procedure/function 'Local' assigned to procedure variable }
end;

At line 13 compiler emits message with ERROR level, prohibiting all of the cases of such local procedures usage. "Official" resolution is to promote Local symbol to the outer scope (ie: make it a sibling of Global) which would have negative impact on code "structuredness".

---

I'm seeking the way to circumvent it in most graceful manner, preferably causing compiler to emit WARNING level message.

Answer 1

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 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

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.

Answer 4

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;