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

View File

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

View File

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

View File

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