I (also) answer my own question as I will take yet another approach. It provides for the following requirements:
- I like to keep the
raise statements, as they initially were,
- so there won't be any necessary code changes here, and
- which also means there won't be newly introduced warnings like W1035 or W1036.
- I don't want to rebuild the inner RTL mechanics, however
- I want to interfere with the RTL mechanics as little as possible.
- I want to be flexible in controlling for chaining exceptions
- sometimes forced or by default, on the exception implementation side, as well as
- sometimes by argument, on the exception usage side, to extend functionality.
In my solution:
- I accept to break through the
Exception fields' visibility, FAcquireInnerException specifically.
- I rely on RTTI to verify the fields' alignment (in
ExceptionFields, according to Exception).
Here I provide a condensed implementation to copy-and-paste:
EException's constructor showcases the use of ExceptionFields:
ExceptionFields(Self).FAcquireInnerException := True;
-- to be used in any Exception-derived exception, and it will trigger the RTL mechanics to set the InnerException while it is raising the exception. Also, EException may serve as a common root for custom exception classes, if desired. Some constructors are reintroduced to be extended with const AcquireInnerException: Boolean = True, to hand-over the control to the caller while providing a default for the desired chaining.
Run ExceptionFields.VerifyFieldAlignments, if you want to verify the alignments of
- the ("re-") declared externally accessible fields in
ExceptionFields and
- their (private) counterparts in
Exception.
If it cannot verify this, it will raise an exception. It is run in EException's class constructor. Move it as propriate to you, if you do not use EException, yet want to keep the verification.
(Condensed) implementation:
unit Exceptions;
interface
uses
System.SysUtils;
type
EException = class (Exception)
public
class constructor Create;
constructor Create(const Msg: String; const AcquireInnerException: Boolean = True);
constructor CreateFmt(const Msg: String; const Args: array of const; const AcquireInnerException: Boolean = True); overload;
constructor CreateRes(const Msg: PResStringRec; const AcquireInnerException: Boolean = True);
constructor CreateResFmt(const Msg: PResStringRec; const Args: array of const; const AcquireInnerException: Boolean = True); overload;
end;
type
ExceptionFields = class (TObject)
{$Hints Off} // H2219
strict private
FMessage: String;
FHelpContext: Integer;
FInnerException: Exception;
FStackInfo: Pointer;
{$Hints On}
public
FAcquireInnerException: Boolean;
private
class procedure VerifyFieldAlignments;
end;
implementation
uses
System.Generics.Collections,
System.RTTI,
System.TypInfo;
{ ExceptionFields }
class procedure ExceptionFields.VerifyFieldAlignments;
procedure RaiseTypeNotFound(const ClassName: String);
begin
raise Exception.CreateFmt(
'Typ nicht gefunden: %s',
[ClassName]
);
end;
procedure RaiseFieldNotFound(const ClassName, FieldName: String);
begin
raise Exception.CreateFmt(
'Feld nicht gefunden: %s.%s',
[ClassName, FieldName]
);
end;
procedure RaiseFieldNotAligned(const LeftClassName: String; const LeftField: TPair<String, Integer>; const RightClassName: String; const RightField: TRTTIField);
begin
raise Exception.CreateFmt(
'Feld nicht ausgerichtet: %s.%s+%d (tatsächlich) vs. %s.%s+%d (erwartet)',
[
LeftClassName,
LeftField.Key,
LeftField.Value,
RightClassName,
RightField.Name,
RightField.Offset
]
);
end;
type
TMemberVisibilities = set of TMemberVisibility;
function GetDeclaredFields(const RTTIContext: TRTTIContext; const &Class: TClass; const IncludedVisibilities: TMemberVisibilities = [mvPublic, mvPublished]): TArray<TPair<String, Integer>>;
var
RTTIType: TRTTIType;
RTTIFields: TArray<TRTTIField>;
Index: NativeInt;
RTTIField: TRTTIField;
begin
RTTIType := RTTIContext.GetType(&Class);
if not Assigned(RTTIType) then
RaiseTypeNotFound(&Class.ClassName);
RTTIFields := RTTIType.GetDeclaredFields;
SetLength(Result, Length(RTTIFields));
Index := 0;
for RTTIField in RTTIFields do
if RTTIField.Visibility in IncludedVisibilities then
begin
Result[Index] := TPair<String, Integer>.Create(
RTTIField.Name,
RTTIField.Offset
);
Inc(Index);
end;
SetLength(Result, Index);
end;
const
Left: TClass = ExceptionFields;
Right: TClass = Exception;
var
RTTIContext: TRTTIContext;
DeclaredFields: TArray<TPair<String, Integer>>;
RTTIType: TRTTIType;
DeclaredField: TPair<String, Integer>;
RTTIField: TRTTIField;
begin
RTTIContext := TRTTIContext.Create;
try
DeclaredFields := GetDeclaredFields(RTTIContext, Left);
RTTIType := RTTIContext.GetType(Right);
if not Assigned(RTTIType) then
RaiseTypeNotFound(Right.ClassName);
for DeclaredField in DeclaredFields do
begin
RTTIField := RTTIType.GetField(DeclaredField.Key);
if not Assigned(RTTIField) then
RaiseFieldNotFound(Right.ClassName, DeclaredField.Key);
if DeclaredField.Value <> RTTIField.Offset then
RaiseFieldNotAligned(
Left.ClassName, DeclaredField,
RTTIType.Name, RTTIField
);
end;
finally
RTTIContext.Free;
end;
end;
{ EException }
class constructor EException.Create;
begin
inherited;
ExceptionFields.VerifyFieldAlignments;
end;
constructor EException.Create(const Msg: String;
const AcquireInnerException: Boolean);
begin
inherited Create(Msg);
ExceptionFields(Self).FAcquireInnerException := AcquireInnerException;
end;
constructor EException.CreateFmt(const Msg: String;
const Args: array of const;
const AcquireInnerException: Boolean);
begin
inherited CreateFmt(Msg, Args);
ExceptionFields(Self).FAcquireInnerException := AcquireInnerException;
end;
constructor EException.CreateRes(const Msg: PResStringRec;
const AcquireInnerException: Boolean);
begin
inherited CreateRes(Msg);
ExceptionFields(Self).FAcquireInnerException := AcquireInnerException;
end;
constructor EException.CreateResFmt(const Msg: PResStringRec;
const Args: array of const;
const AcquireInnerException: Boolean);
begin
inherited CreateResFmt(Msg, Args);
ExceptionFields(Self).FAcquireInnerException := AcquireInnerException;
end;
end.
And a demo:
program ExceptionsDemo;
{$AppType Console}
{$R *.res}
uses
System.SysUtils,
Exceptions in 'Exceptions.pas';
type
EDemoException = class (EException)
end;
begin
try
try
try
raise EZeroDivide.Create('Level 3');
except
raise EException.Create('Level 2', False);
end;
except
raise EDemoException.Create('Level 1');
end;
except
on E: Exception do
begin
WriteLn(E.ClassName, ': ', E.Message);
while Assigned(E.InnerException) do
begin
E := E.InnerException;
WriteLn(E.ClassName, ': ', E.Message);
end;
end;
end;
ReadLn;
end.
Output -- the last line is only there on raise EException.Create('Level 2', True):
EDemoException: Level 1
EException: Level 2
EZeroDivide: Level 3
Thank you to all repliers!
procedure Inv; begin raise EFrogProperties.Create('Invalid frog properties.'); end;and would also love somenoreturnkeyword so the compiler knows that it will never return to the caller. – WrennieRaiseOuterException(). Why they didn't simply introduce a new constructor that captures an existingExceptionor acquires the currentException, or at least aCreateOuterException()method that returns a newExceptionthat can beraised separately, is behind me. – Almsgivernoreturnkeyword or attribute? (Maybe not to solve this particular issue, but in general.) – Wrennieprivate FAcquireInnerException: Boolean = Falserenders the whole mechanic inExceptioninaccessible; i.e.protected procedure SetInnerExceptionbecomes a no-op to derieved classes, for example. Do you reimplement the mechanics? That is quite some things to keep track of to stay on par withException. Or do you break throughFAcquireInnerException's visibility? Would you share the code of yourEChainedException? – Concessionaire