From 6ae339b2fe6107d56dd1c762721cab0fed962b4e Mon Sep 17 00:00:00 2001 From: TetzkatLipHoka Date: Sat, 11 Jul 2026 11:16:22 +0200 Subject: [PATCH] Make failing interface/object casts catchable by script try/except The cast import (SpecImport's CastProc) reported failed interface and 'as' casts via CMD_Err2 and then returned False. CMD_Err2 already dispatches the error to the script's active exception handler and resets the pending-error state - so when the external proc afterwards returned False, the interpreter raised a second erCouldNotCallProc for which the handler was already consumed. Net effect: a failing cast could never be caught by try/except in a script, and the descriptive 'Cannot cast an interface/object' message was replaced by a generic 'Could not call proc'. Return True after CMD_Err2 instead, exactly like the DefProc builtins handle their reported errors (e.g. the string index checks). A failing cast now surfaces as a regular catchable runtime error with its proper message: try f := IMyFoo(u); // u does not implement IMyFoo except // reached now; previously the script died with 'Could not call proc' end; Co-Authored-By: Claude Fable 5 --- Source/uPSRuntime.pas | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/Source/uPSRuntime.pas b/Source/uPSRuntime.pas index d22c6182..c82a96b0 100644 --- a/Source/uPSRuntime.pas +++ b/Source/uPSRuntime.pas @@ -11259,7 +11259,7 @@ function CastProc(Caller: TPSExec; p: TPSExternalProcRec; Global, Stack: TPSStac if (IUnknown(invar.Dta^) = nil) or (IUnknown(invar.Dta^).QueryInterface(TPSTypeRec_Interface(ResVar.aType).Guid, IUnknown(resvar.Dta^)) <> 0) then begin Caller.CMD_Err2(erCustomError, tbtString(RPS_CannotCastInterface)); - Result := False; + Result := True; // error already dispatched by CMD_Err2 exit; end; {$IFDEF Delphi3UP} @@ -11273,7 +11273,7 @@ function CastProc(Caller: TPSExec; p: TPSExternalProcRec; Global, Stack: TPSStac if (TObject(invar.Dta^)= nil) or (not TObject(invar.dta^).GetInterface(TPSTypeRec_Interface(ResVar.aType).Guid, IUnknown(resvar.Dta^))) then begin Caller.CMD_Err2(erCustomError, tbtString(RPS_CannotCastInterface)); - Result := False; + Result := True; // error already dispatched by CMD_Err2 exit; end; {$ENDIF} @@ -11303,8 +11303,8 @@ function CastProc(Caller: TPSExec; p: TPSExternalProcRec; Global, Stack: TPSStac try TObject(ResVar.Dta^) := TObject(InVar.Dta^) as FSelf; except - Result := False; Caller.CMD_Err2(erCustomError, tbtString(RPS_CannotCastObject)); + Result := True; // error already dispatched by CMD_Err2 exit; end; end else