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 开发者_如何学Pythonof 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.
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.
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.
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.
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;
精彩评论