shikhalev.org

«Обернутые» функции в Free Pascal

•

Бывает, требуется множество подпрограмм единообразно обернуть — добавить им всем одинаковое начало и завершение или, что более интересно, выполнить их в блоке „try ... except“ с каким-нибудь фильтром на исключения… Вообще, понятно, что FPC поддерживает процедурные типы, но как раз типы тут могут быть самые разные, а нетипизированный вызов с руч­ной установкой стека — это потенциальный неиссякаемый источник трудноуловимых ошибок.

Тут самое время вспомнить, что FPC с некоторых пор поддерживает еще и вложенные процедурные типы, а вложенная процедура имеет доступ ко всей области видимости внешней, включая, естественно, аргументы и псевдопеременную result.

Соответственно, можно вынести все действия подпрограммы во вложенную процедуру без па­ра­мет­ров, а в ос­нов­ной блок вставить вызов «оборачивателя» с этой вложенной процедурой. Далее пример.

Определение обертки

Выводим на консоль исключение, если оно произошло, с пометкой времени.

{$mode objfpc}
{$modeswitch nestedprocvars}
{$longstrings on}

unit Logger;

interface

uses
  SysUtils;

type
  TCode = procedure is nested;

procedure wrapper (const code : TCode);

implementation

procedure wrapper (const code : TCode);
 begin
  try
   code();
  except
    on e : Exception do
       begin
        WriteLn('[' + e.ClassName + ' at ' + DateTimeToStr(Now) + ']: ' +
                e.Message);
        raise;
       end;
  end;
 end;

end.

Замечу, что полученное исключение мы отправляем далее по стеку, не подавляем.

Использование

{$mode objfpc}
{$modeswitch nestedprocvars}
{$longstrings on}

program Test;

uses
  Logger;

function divide (x, y : Double) : Double;

 procedure _;
  begin
   result := x / y;
  end;

 begin
  wrapper(@_);
 end;

var
  x : Double;

begin
 try
  x := divide(1.1, 2.0);
  WriteLn(x:5:3);
  x := divide(1.1, 0.0);
  WriteLn(x:5:3);
 except
 end;
end.