paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-12-05 09:47:25 +01:00
Code Issues Packages Projects Releases Wiki Activity

* Allow to specify message when calling internal error

Browse Source
This commit is contained in:
Michaël Van Canneyt 2025-09-29 20:41:43 +02:00
parent b225ba2778
commit c4d4beec8d
2 changed files with 24 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
compiler/comphook.pas
View File

@ -110,6 +110,7 @@ var
Function def_status:boolean;
Function def_comment(Level:Longint;const s:ansistring):boolean;
function def_internalerror(i:longint):boolean;
function def_internalerrorEx(i:longint;const s:ansistring):boolean;
function def_CheckVerbosity(v:longint):boolean;
procedure def_initsymbolinfo;
procedure def_donesymbolinfo;
@ -122,6 +123,7 @@ type
tstatusfunction = function:boolean;
tcommentfunction = function(Level:Longint;const s:ansistring):boolean;
tinternalerrorfunction = function(i:longint):boolean;
tinternalerrorexfunction = function(i:longint; const s : ansistring):boolean;
tcheckverbosityfunction = function(i:longint):boolean;
tinitsymbolinfoproc = procedure;
@ -133,7 +135,8 @@ type
const
do_status : tstatusfunction = @def_status;
do_comment : tcommentfunction = @def_comment;
do_internalerror : tinternalerrorfunction = @def_internalerror;
do_internalerror : tinternalerrorfunction = @def_internalerror deprecated 'use do_internalerrorex';
do_internalerrorex : tinternalerrorexfunction = @def_internalerrorex;
do_checkverbosity : tcheckverbosityfunction = @def_checkverbosity;
do_initsymbolinfo : tinitsymbolinfoproc = @def_initsymbolinfo;
@ -420,13 +423,24 @@ end;
function def_internalerror(i : longint) : boolean;
begin
do_comment(V_Fatal+V_LineInfo,'Internal error '+tostr(i));
result:=def_internalerrorex(i,'');
end;
function def_internalerrorex(i : longint; const s : ansistring) : boolean;
var
msg : ansistring;
begin
msg:=S;
if msg<>'' then
msg:=': '+msg;
msg:='Internal error '+tostr(i)+msg;
do_comment(V_Fatal+V_LineInfo,msg);
{$ifdef EXTDEBUG}
{ Internalerror() and def_internalerror() do not
have a stackframe }
dump_stack(stdout,get_caller_frame(get_frame));
{$endif EXTDEBUG}
def_internalerror:=true;
def_internalerrorex:=true;
end;
function def_CheckVerbosity(v:longint):boolean;

8
compiler/verbose.pas
View File

@ -65,6 +65,7 @@ interface
procedure SetErrorFlags(const s:string);
procedure GenerateError;
procedure Internalerror(i:longint);noreturn;
procedure Internalerror(i:longint; const s : ansistring);noreturn;
procedure Comment(l:longint;s:ansistring);
function MessageStr(w:longint):TMsgStr;
procedure Message(w:longint;onqueue:tmsgqueueevent=nil);
@ -572,13 +573,18 @@ implementation
procedure internalerror(i : longint);noreturn;
begin
InternalError(i,'');
end;
procedure InternalError(i:longint; const s : ansistring);noreturn;
procedure doraise;
begin
raise ECompilerAbort.Create;
end;
begin
UpdateStatus;
do_internalerror(i);
do_internalerrorex(i,s);
GenerateError;
doraise;
end;