paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-13 10:39:39 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Fixed reading of float constant after changes in r20190. ppudump now read PPUs without fatal errors.

Browse Source 
* Replaced assignment "has_errors:=true" by calling a new procedure SetHasErrors. It simplifies debugging - just set a breakpoint inside SetHasErrors and see the stack back trace to find out where the error has occurred.

git-svn-id: trunk@23633 -
This commit is contained in:
yury 2013-02-20 13:13:19 +00:00
parent 4eb660699c
commit a530bb1bb0
1 changed files with 28 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

49
compiler/utils/ppudump.pp
View File

@ -1,5 +1,5 @@
{ {
Copyright (c) 1998-2002 by the FPC Development Team Copyright (c) 1998-2013 by the FPC Development Team
Dumps the contents of a FPC unit file (PPU File) Dumps the contents of a FPC unit file (PPU File)
@ -38,9 +38,9 @@ uses
tokens; tokens;
const const
Version = 'Version 2.5.1'; Version = 'Version 2.7.1';
Title = 'PPU-Analyser'; Title = 'PPU-Analyser';
Copyright = 'Copyright (c) 1998-2010 by the Free Pascal Development Team'; Copyright = 'Copyright (c) 1998-2013 by the Free Pascal Development Team';
{ verbosity } { verbosity }
v_none = $0; v_none = $0;
@ -281,16 +281,21 @@ begin
has_more_infos:=true; has_more_infos:=true;
end; end;
procedure SetHasErrors;
begin
has_errors:=true;
end;
Procedure WriteError(const S : string); Procedure WriteError(const S : string);
Begin Begin
Writeln(S); Writeln(S);
has_errors:=true; SetHasErrors;
End; End;
function Unknown(const st : string; val :longint) : string; function Unknown(const st : string; val :longint) : string;
Begin Begin
Unknown:='<!! Unknown'+st+' value '+tostr(val)+'>'; Unknown:='<!! Unknown'+st+' value '+tostr(val)+'>';
has_errors:=true; SetHasErrors;
end; end;
function ToStr(w:longint):String; function ToStr(w:longint):String;
@ -439,7 +444,7 @@ begin
if ntflags<>0 then if ntflags<>0 then
begin begin
s:=s+' unknown '+hexstr(ntflags,8); s:=s+' unknown '+hexstr(ntflags,8);
has_errors:=true; SetHasErrors;
end; end;
PPUFlags2Str:=s; PPUFlags2Str:=s;
end; end;
@ -473,7 +478,7 @@ end;
if t=-1 then if t=-1 then
begin begin
Result := 'Not Found'; Result := 'Not Found';
has_errors:=true; SetHasErrors;
exit; exit;
end; end;
DT := FileDateToDateTime(t); DT := FileDateToDateTime(t);
@ -493,7 +498,7 @@ var
begin begin
if ppufile.readentry<>ibrecsymtableoptions then if ppufile.readentry<>ibrecsymtableoptions then
begin begin
has_errors:=true; SetHasErrors;
exit; exit;
end; end;
writeln(space,' recordalignment: ',shortint(ppufile.getbyte)); writeln(space,' recordalignment: ',shortint(ppufile.getbyte));
@ -522,7 +527,7 @@ var
begin begin
if ppufile.readentry<>ibsymtableoptions then if ppufile.readentry<>ibsymtableoptions then
begin begin
has_errors:=true; SetHasErrors;
exit; exit;
end; end;
ppufile.getsmallset(options); ppufile.getsmallset(options);
@ -744,7 +749,7 @@ begin
else else
begin begin
bindstr:='<Error !!>'; bindstr:='<Error !!>';
has_errors:=true; SetHasErrors;
end; end;
end; end;
case tasmsymtype(ppufile.getbyte) of case tasmsymtype(ppufile.getbyte) of
@ -761,7 +766,7 @@ begin
else else
begin begin
typestr:='<Error !!>'; typestr:='<Error !!>';
has_errors:=true; SetHasErrors;
end; end;
end; end;
Writeln(space,' ',i,' : ',s,' [',bindstr,',',typestr,']'); Writeln(space,' ',i,' : ',s,' [',bindstr,',',typestr,']');
@ -829,7 +834,7 @@ begin
if (idx>derefdatalen) then if (idx>derefdatalen) then
begin begin
writeln('!! Error: Deref idx ',idx,' > ',derefdatalen); writeln('!! Error: Deref idx ',idx,' > ',derefdatalen);
has_errors:=true; SetHasErrors;
exit; exit;
end; end;
write(derefspace,'(',idx,') '); write(derefspace,'(',idx,') ');
@ -874,7 +879,7 @@ begin
else else
begin begin
writeln('!! unsupported dereftyp: ',ord(b)); writeln('!! unsupported dereftyp: ',ord(b));
has_errors:=true; SetHasErrors;
break; break;
end; end;
end; end;
@ -1835,7 +1840,7 @@ begin
begin begin
writeln('!! ibcreatedobjtypes entry not found'); writeln('!! ibcreatedobjtypes entry not found');
ppufile.skipdata(ppufile.entrysize); ppufile.skipdata(ppufile.entrysize);
has_errors:=true; SetHasErrors;
exit exit
end; end;
writeln; writeln;
@ -1996,6 +2001,8 @@ begin
end; end;
constreal : constreal :
begin begin
write (space,' RealType : ');
readderef('');
write(space,' Value : '); write(space,' Value : ');
if entryleft=sizeof(ppureal) then if entryleft=sizeof(ppureal) then
begin begin
@ -2021,7 +2028,7 @@ begin
begin begin
realvalue:=0.0; realvalue:=0.0;
writeln(realvalue,' Error reading real value'); writeln(realvalue,' Error reading real value');
has_errors:=true; SetHasErrors;
end; end;
end; end;
constset : constset :
@ -2238,7 +2245,7 @@ begin
else else
begin begin
WriteLn('!! Skipping unsupported PPU Entry in Symbols: ',b); WriteLn('!! Skipping unsupported PPU Entry in Symbols: ',b);
has_errors:=true; SetHasErrors;
end; end;
end; end;
if not EndOfEntry then if not EndOfEntry then
@ -2664,7 +2671,7 @@ begin
else else
begin begin
WriteLn('!! Skipping unsupported PPU Entry in definitions: ',b); WriteLn('!! Skipping unsupported PPU Entry in definitions: ',b);
has_errors:=true; SetHasErrors;
end; end;
end; end;
if not EndOfEntry then if not EndOfEntry then
@ -2826,7 +2833,7 @@ begin
else else
begin begin
WriteLn('!! Skipping unsupported PPU Entry in General Part: ',b); WriteLn('!! Skipping unsupported PPU Entry in General Part: ',b);
has_errors:=true; SetHasErrors;
end; end;
end; end;
until false; until false;
@ -2864,7 +2871,7 @@ begin
else else
begin begin
WriteLn('!! Skipping unsupported PPU Entry in Implementation: ',b); WriteLn('!! Skipping unsupported PPU Entry in Implementation: ',b);
has_errors:=true; SetHasErrors;
end; end;
end; end;
until false; until false;
@ -2889,7 +2896,7 @@ begin
if not ppufile.CheckPPUID then if not ppufile.CheckPPUID then
begin begin
writeln(Filename,' : Not a valid PPU file, Skipping'); writeln(Filename,' : Not a valid PPU file, Skipping');
has_errors:=true; SetHasErrors;
exit; exit;
end; end;
{ Check PPU Version } { Check PPU Version }
@ -2899,7 +2906,7 @@ begin
if PPUVersion<16 then if PPUVersion<16 then
begin begin
writeln(Filename,' : Old PPU Formats (<v16) are not supported, Skipping'); writeln(Filename,' : Old PPU Formats (<v16) are not supported, Skipping');
has_errors:=true; SetHasErrors;
exit; exit;
end; end;
{ Write PPU Header Information } { Write PPU Header Information }