浏览代码

Integrate patch from bug report 35409.
Add possibiliy to throw InternalError
for unhandled case values inside tentryfile,
But avoid adding dependency on verbose unit
as this would break ppudump handling of ppu files.

Add RaiseAssertion virtual method to tentryfile class.
Call RaiseAssertion in tentryfile methods
where an internal error is wanted.
Override RaiseAssertion method in symtype.pas unit
to call InternalError.
Add new class tppudumpfile to override RaiseAssertion
in utils/ppuutils/ppudump.pp unit.

git-svn-id: trunk@41896 -

pierre 6 年之前
父节点
当前提交
ec76e879c9
共有 4 个文件被更改,包括 54 次插入7 次删除
  1. 27 5
      compiler/entfile.pas
  2. 7 0
      compiler/pcp.pas
  3. 6 0
      compiler/symtype.pas
  4. 14 2
      compiler/utils/ppuutils/ppudump.pp

+ 27 - 5
compiler/entfile.pas

@@ -236,6 +236,7 @@ type
     procedure resetfile;virtual;abstract;
     function getheadersize:longint;virtual;abstract;
     function getheaderaddr:pentryheader;virtual;abstract;
+    procedure RaiseAssertion(Code: Longint); virtual;
   public
     entrytyp : byte;
     size             : integer;
@@ -384,6 +385,13 @@ begin
 end;
 
 
+procedure tentryfile.RaiseAssertion(Code: Longint);
+begin
+  { It's down to descendent classes to raise an internal error as desired. [Kit] }
+  error := true;
+end;
+
+
 procedure tentryfile.closefile;
 begin
   if mode<>0 then
@@ -744,12 +752,16 @@ begin
       result:=0;
     end;
 {$else not generic_cpu}
-  result:=4;
   case sizeof(aint) of
     8: result:=getint64;
     4: result:=getlongint;
     2: result:=smallint(getword);
     1: result:=shortint(getbyte);
+  else
+    begin
+      RaiseAssertion(2019041801);
+      result:=0;
+    end;
   end;
 {$endif not generic_cpu}
 end;
@@ -788,9 +800,12 @@ begin
     4: result:=asizeint(getlongint);
     2: result:=asizeint(getword);
     1: result:=asizeint(getbyte);
-    else
+  else
+    begin
+      RaiseAssertion(2019041802);
       result:=0;
-end;
+    end;
+  end;
 {$endif not generic_cpu}
 end;
 
@@ -821,7 +836,10 @@ begin
     2: result:=getword;
     1: result:=getbyte;
   else
-    result:=0;
+    begin
+      RaiseAssertion(2019041803);
+      result:=0;
+    end;
   end;
 {$endif not generic_cpu}
 end;
@@ -870,12 +888,16 @@ begin
       result:=0;
     end;
 {$else not generic_cpu}
-  result:=4;
   case sizeof(aword) of
     8: result:=getqword;
     4: result:=getdword;
     2: result:=getword;
     1: result:=getbyte;
+  else
+    begin
+      RaiseAssertion(2019041804);
+      result:=0;
+    end;
   end;
 {$endif not generic_cpu}
 end;

+ 7 - 0
compiler/pcp.pas

@@ -61,6 +61,7 @@ interface
       procedure newheader;override;
       function readheader:longint;override;
       procedure resetfile;override;
+      procedure RaiseAssertion(Code: Longint); override;
     public
       procedure writeheader;override;
       function checkpcpid:boolean;
@@ -84,6 +85,12 @@ uses
       result:=@header;
     end;
 
+  procedure tpcpfile.RaiseAssertion(Code: Longint);
+    begin
+      // InternalError(nb);
+      inherited RaiseAssertion(Code);
+    end;
+
   procedure tpcpfile.newheader;
     var
       s : string;

+ 6 - 0
compiler/symtype.pas

@@ -206,6 +206,8 @@ interface
          procedure putderef(const d:tderef);
          procedure putpropaccesslist(p:tpropaccesslist);
          procedure putasmsymbol(s:tasmsymbol);
+       protected
+         procedure RaiseAssertion(Code: Longint); override;
        end;
 
 {$ifdef MEMDEBUG}
@@ -887,6 +889,10 @@ implementation
          Message(unit_f_ppu_read_error);
       end;
 
+    procedure tcompilerppufile.RaiseAssertion(Code: Longint);
+      begin
+        InternalError(Code);
+      end;
 
     procedure tcompilerppufile.getguid(var g: tguid);
       begin

+ 14 - 2
compiler/utils/ppuutils/ppudump.pp

@@ -215,8 +215,14 @@ type
     ModuleFlags: tmoduleflags;
   end;
 
+type
+  tppudumpfile = class(tppufile)
+  protected
+    procedure RaiseAssertion(Code: Longint); override;
+  end;
+
 var
-  ppufile     : tppufile;
+  ppufile     : tppudumpfile;
   ppuversion  : dword;
   space       : string;
   verbose     : longint;
@@ -334,6 +340,12 @@ Begin
   SetHasErrors;
 End;
 
+procedure tppudumpfile.RaiseAssertion(Code: Longint);
+begin
+  WriteError('Internal Error ' + ToStr(Code));
+  inherited RaiseAssertion(Code);
+end;
+
 Procedure WriteWarning(const S : string);
 var
   ss: string;
@@ -3912,7 +3924,7 @@ begin
 { fix filename }
   if pos('.',filename)=0 then
    filename:=filename+'.ppu';
-  ppufile:=tppufile.create(filename);
+  ppufile:=tppudumpfile.create(filename);
   if not ppufile.openfile then
    begin
      WriteError('IO-Error when opening : '+filename+', Skipping');