瀏覽代碼

* Allow to specify message when calling internal error

Michaël Van Canneyt 1 周之前
父節點
當前提交
c4d4beec8d
共有 2 個文件被更改,包括 24 次插入4 次删除
  1. 17 3
      compiler/comphook.pas
  2. 7 1
      compiler/verbose.pas

+ 17 - 3
compiler/comphook.pas

@@ -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;

+ 7 - 1
compiler/verbose.pas

@@ -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;