Изящно ослабьте ограничение «Локальная процедура / функция, назначенная переменной процедуры» - PullRequest
8 голосов
/ 18 февраля 2011

Рассмотрим следующий тестовый пример:

{ 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), что негативно скажется на «структурированности» кода.


I'mища способ обойти его самым изящным способом, предпочтительно заставляя компилятор выдавать сообщение уровня WARNING.

Ответы [ 4 ]

8 голосов
/ 18 февраля 2011

Лучше всего объявить его как reference to procedure, используя новую функцию анонимных методов, и тогда вы сможете сохранить все в инкапсуляции.

type
  TProc = reference to procedure;

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

Это позволяет обойти проблемы, которые Мейсон описывает захват любых переменных, локальных для анонимной функции.

5 голосов
/ 18 февраля 2011

Вот почему вы не можете сделать это:

type
  TProcedure = procedure ();

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

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

begin
  result := Local;
end;

Локальные процедуры имеют доступ к области переменных внешней подпрограммы. Эти переменные объявляются в стеке и становятся недействительными после возврата внешней процедуры.

Однако, если вы используете CompilerVersion 21 (Delphi 2010), у вас есть анонимных методов , которые должны быть в состоянии выполнить то, что вы ищете; вам просто нужен немного другой синтаксис.

1 голос
/ 29 февраля 2016

Если действительно нужно использовать локальные процедуры в 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;

Однако проблема в том, что адресные регистры могут различаться на разных машинах - поэтому необходимо написатькод с использованием локального вызова proc и просмотр через точку останова, какие регистры там используются ...

И да - в большинстве реальных производственных случаев этот трюк является просто своего рода паллиативным.

0 голосов
/ 18 февраля 2011

Для записей, мое домашнее закрытие:

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