mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-07 13:28:05 +02:00
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:
parent
28c15a95d5
commit
ec76e879c9
@ -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;
|
||||
|
@ -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;
|
||||
|
@ -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
|
||||
|
@ -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');
|
||||
|
Loading…
Reference in New Issue
Block a user