优雅地放宽“局部过程/函数赋值给过程变量”的限制

Question

考虑以下测试用例：

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

在第13行，编译器发出ERROR级别的消息，禁止使用此类本地过程。 "官方"解决方法是将 Local 符号提升到外部范围（即：使其成为 Global 的同级），这将对代码“结构性”产生负面影响。

---

我正在寻找最优雅的方法来规避它，最好是引起编译器发出WARNING级别的消息。

- Free Consulting

---

我很好奇为什么你想要一个指向本地函数的指针？强制编译器允许这样做没有优雅的方式。但也许你可以找出他们调用本地函数时发出的代码，并自己发出它，使用指向该本地函数的指针作为指针类型变量，而不是TProcedure类型。 - Warren P

@Rob，Andreas删除的答案只包含一个调用ShowMessage的函数，堆栈状态可能并不重要。我试图不太严厉地对待它，特别是当他意识到错误时删除了它。无论如何，你可以从我的答案中看出我认为应该如何做！ - David Heffernan

@David，@Rob：让我意识到我的代码不好的主要原因并不是局部过程无法从其父过程外部调用（谁会考虑那么病态的事情呢？），而是当你使用“我的”代码从global内部调用local时，如果尝试更改局部变量，就会出现奇怪的错误（内存损坏），而这种情况经常发生。 - Andreas Rejbrand

@Worm 致意：我已经将它恢复了（至少是暂时的），这样大家在讨论它的时候就可以看到了。 - Andreas Rejbrand

@Sertac：哎呀！那听起来像是一个丑陋的黑客攻击。只是想到它所涉及的内容就让我头痛！:P - Mason Wheeler

Answer 1

你最好使用新的匿名方法特性将其声明为过程引用，这样你就可以保持所有内容的封装。

type
  TProc = reference to procedure;

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

通过捕获匿名函数中的任何局部变量，可以解决Mason所描述的问题。

- David Heffernan

---

没错。如果你真的对捕获的工作原理感兴趣，可以在这里找到解释：http://tech.turbu-rpg.com/13/whats-in-a-name-less-method - Mason Wheeler

@Mason Barry Kelly 也在博客中广泛地谈到了这个问题。 - David Heffernan

@Jeroen：你是指D2009及以上版本，对吧？（尽管如果有更新的版本可用，我不建议使用2009。） - Mason Wheeler

它主要用于在过程级别上的访问者模式。在父过程中构建上下文，使用局部过程调用迭代器（然后可以通过对父变量的访问来访问数据/上下文）。或者，它可以用于同时接受本地和全局（父frm=nil）过程类型的过程。例如Turbo Vision非常需要它。 - Marco van de Voort

我提交了QC#91876，这是上述AV的描述。 - David Heffernan

Answer 2

以下是您无法做到的原因：

type
  TProcedure = procedure ();

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

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

begin
  result := Local;
end;

本地过程可以访问外部程序的变量范围。然而，这些变量是在堆栈上声明的，并且一旦外部过程返回，它们就会失效。

但是，如果您使用的是编译器版本21（Delphi 2010），则可以使用匿名方法实现您所需的功能；您只需要稍微不同的语法即可。详见此链接。

- Mason Wheeler

---

是的，我知道这些情况。实际上，将Local的生命周期延长到其父范围会带来麻烦。然而，在某些情况下，使用是完全有效的。 - Free Consulting

顺便提一下，localint 没有初始化。使用可写类型常量解决它会创建自制闭包 :) - Free Consulting

@Worm：是的，差不多，除了每次过程运行时你只会得到一个而不是新的。 :) - Mason Wheeler

我已经将本地变量分配为10并从本地过程中打印出来。它打印了0。这个东西可能是有问题的，最好避免使用它。 - OCTAGRAM

Answer 3

如果确实需要在D7或更早版本中使用本地过程，可以使用以下技巧：

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;

然而问题在于不同机器上的地址寄存器可能会有所不同，因此需要编写一些代码使用本地进程调用并通过断点查看在那里使用哪些寄存器...

是的，在大多数实际生产情况下，这种技巧只是某种缓解措施。

- Markus_13

Answer 4

记录一下，我自己编写的闭包：

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

- Free Consulting

---

@Worm 如果我没记错的话，局部函数和全局函数有不同的堆栈设置，所以你需要小心使用这个技巧。 - Jeroen Wiert Pluimers

@Mason Wheeler，它并不是全局的，但确实只有一个与“Local”例程绑定的“Answer”数据，这正是我所展示的。 - Free Consulting

当编译器可以干净、安全地为你完成时，实际上并没有必要采用这样肮脏的黑客方式。 - David Heffernan

@David Heffernan，好的，请证明这个给定的例子是“不安全”的。 - Free Consulting

重点在于没有必要这样做。即使它能够工作，为什么要这样做呢？闭包功能是你应该使用的方式。为什么要与之对抗呢？ - David Heffernan