2
0
Эх сурвалжийг харах

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 жил өмнө
parent
commit
ec76e879c9

+ 27 - 5
compiler/entfile.pas

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

+ 7 - 0
compiler/pcp.pas

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

+ 6 - 0
compiler/symtype.pas

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

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

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