System.Defer/System.Defer.pas at main · HemulGM/System.Defer · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
unit System.Defer;

interface

uses
  System.SysUtils;

{$SCOPEDENUMS ON}

type
  IDefer = interface
  end;

  TDeferAction = (Always, OnError, NoError);

  TDefer = class(TInterfacedObject, IDefer)
  protected
    FProc: TProc;
    FObj: TObject;
    FAction: TDeferAction;
    function NeedDestroy: Boolean; virtual;
  public
    constructor Create(Proc: TProc; Action: TDeferAction = TDeferAction.Always); reintroduce; overload;
    constructor Create(Obj: TObject; Action: TDeferAction = TDeferAction.Always); reintroduce; overload;
    destructor Destroy; override;
  end;

/// <summary>
/// Performs the procedure when leaving the block
/// </summary>
function defer(Proc: TProc): IDefer; inline; overload;

/// <summary>
/// Performs the procedure when leaving the block due to exclusion
/// </summary>
function errdefer(Proc: TProc): IDefer; inline; overload;

/// <summary>
/// Performs the procedure when leaving the block if there was no exception
/// </summary>
function noerrdefer(Proc: TProc): IDefer; inline; overload;

/// <summary>
/// Releases the object when leaving the block
/// </summary>
function defer(Obj: TObject): IDefer; inline; overload;

/// <summary>
/// Releases the object when leaving the block due to exclusion
/// </summary>
function errdefer(Obj: TObject): IDefer; inline; overload;

/// <summary>
/// Releases the object when leaving the block if there was no exception
/// </summary>
function noerrdefer(Obj: TObject): IDefer; inline; overload;

implementation

function defer(Proc: TProc): IDefer;
begin
  Result := TDefer.Create(Proc);
end;

function errdefer(Proc: TProc): IDefer;
begin
  Result := TDefer.Create(Proc, TDeferAction.OnError);
end;

function noerrdefer(Proc: TProc): IDefer;
begin
  Result := TDefer.Create(Proc, TDeferAction.NoError);
end;

function defer(Obj: TObject): IDefer;
begin
  Result := TDefer.Create(Obj);
end;

function errdefer(Obj: TObject): IDefer;
begin
  Result := TDefer.Create(Obj, TDeferAction.OnError);
end;

function noerrdefer(Obj: TObject): IDefer;
begin
  Result := TDefer.Create(Obj, TDeferAction.NoError);
end;

{ TDefer }

constructor TDefer.Create(Proc: TProc; Action: TDeferAction);
begin
  inherited Create;
  FAction := Action;
  FProc := Proc;
  FObj := nil;
end;

constructor TDefer.Create(Obj: TObject; Action: TDeferAction);
begin
  inherited Create;
  FAction := Action;
  FProc := nil;
  FObj := Obj;
end;

destructor TDefer.Destroy;
begin
  if not NeedDestroy then
    Exit;
  if Assigned(FProc) then
    FProc();
  FObj.Free;
  inherited;
end;

function TDefer.NeedDestroy: Boolean;
begin
  case FAction of
    TDeferAction.Always:
      Exit(True);
    TDeferAction.OnError:
      Exit(Assigned(ExceptObject()));
    TDeferAction.NoError:
      Exit(not Assigned(ExceptObject()));
  else
    Result := True;
  end;
end;

end.