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 -
This commit is contained in:
pierre 2019-04-18 14:08:03 +00:00
parent 28c15a95d5
commit ec76e879c9
4 changed files with 54 additions and 7 deletions

View File

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

View File

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

View File

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

View File

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