Browse Source

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 years ago
parent
commit
ec76e879c9
4 changed files with 54 additions and 7 deletions
  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');