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

Fix errors and improve ouput of ppudump

Browse Source 
git-svn-id: trunk@29577 -
This commit is contained in:
pierre 2015-01-29 16:37:21 +00:00
parent c5de263637
commit d939a163f7
1 changed files with 98 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

130
compiler/utils/ppuutils/ppudump.pp
View File

@ -289,8 +289,32 @@ const
end;
const has_errors : boolean = false;
has_warnings : boolean = false;
has_more_infos : boolean = false;
procedure SetHasErrors;
begin
has_errors:=true;
end;
Procedure WriteError(const S : string);
Begin
system.Writeln(StdErr, S);
SetHasErrors;
End;
Procedure WriteWarning(const S : string);
var
ss: string;
Begin
ss:='!! Warning: ' + S;
if nostdout then
system.Writeln(StdErr, ss)
else
system.Writeln(ss);
has_warnings:=true;
End;
procedure Write(const s: string);
begin
if nostdout then exit;
@ -300,20 +324,84 @@ end;
procedure Write(const params: array of const);
var
i: integer;
{ Last vtType define in rtl/inc/objpash.inc }
const
max_vttype = vtUnicodeString;
begin
if nostdout then exit;
for i:=Low(params) to High(params) do
{ All vtType in
vtInteger = 0;
vtBoolean = 1;
vtChar = 2;
vtExtended = 3;
vtString = 4;
vtPointer = 5;
vtPChar = 6;
vtObject = 7;
vtClass = 8;
vtWideChar = 9;
vtPWideChar = 10;
vtAnsiString32 = 11; called vtAnsiString in objpas unit
vtCurrency = 12;
vtVariant = 13;
vtInterface = 14;
vtWideString = 15;
vtInt64 = 16;
vtQWord = 17;
vtUnicodeString = 18;
// vtAnsiString16 = 19; not yet used
// vtAnsiString64 = 20; not yet used
}
with TVarRec(params[i]) do
case VType of
vtInteger: system.write(VInteger);
vtBoolean: system.write(VBoolean);
vtChar: system.write(VChar);
vtExtended: system.write(VExtended^);
vtString: system.write(VString^);
vtPointer:
begin
{ Not sure the display will be correct
if sizeof pointer is not native }
WriteWarning('Pointer constant');
end;
vtPChar: system.write(VPChar);
vtObject:
begin
{ Not sure the display will be correct
if sizeof pointer is not native }
WriteWarning('Object constant');
end;
vtClass:
begin
{ Not sure the display will be correct
if sizeof pointer is not native }
WriteWarning('Class constant');
end;
vtWideChar: system.write(VWideChar);
vtPWideChar:
begin
WriteWarning('PWideChar constant');
end;
vtAnsiString: system.write(ansistring(VAnsiString));
vtCurrency : system.write(VCurrency^);
vtVariant :
begin
{ Not sure the display will be correct
if sizeof pointer is not native }
WriteWarning('Variant constant');
end;
vtInterface :
begin
{ Not sure the display will be correct
if sizeof pointer is not native }
WriteWarning('Interface constant');
end;
vtWideString : system.write(widestring(VWideString));
vtInt64: system.write(VInt64^);
vtQWord: system.write(VQWord^);
vtString: system.write(VString^);
vtAnsiString: system.write(ansistring(VAnsiString));
vtPChar: system.write(VPChar);
vtChar: system.write(VChar);
vtBoolean: system.write(VBoolean);
vtExtended: system.write(VExtended^);
vtUnicodeString : system.write(unicodestring(VUnicodeString));
else
begin
system.writeln;
@ -342,28 +430,6 @@ begin
has_more_infos:=true;
end;
procedure SetHasErrors;
begin
has_errors:=true;
end;
Procedure WriteError(const S : string);
Begin
system.Writeln(StdErr, S);
SetHasErrors;
End;
Procedure WriteWarning(const S : string);
var
ss: string;
Begin
ss:='!! Warning: ' + S;
if nostdout then
system.Writeln(StdErr, ss)
else
system.Writeln(ss);
End;
function Unknown(const st : string; val :longint) : string;
Begin
Unknown:='<!! Unknown'+st+' value '+tostr(val)+'>';
@ -2548,9 +2614,8 @@ begin
ibmacrosym :
begin
readcommonsym('Macro symbol ');
writeln([space,' Name: ',getstring]);
writeln([space,' Defined: ',getbyte]);
writeln([space,' Compiler var: ',getbyte]);
writeln([space,' Defined: ',boolean(getbyte)]);
writeln([space,' Compiler var: ',boolean(getbyte)]);
len:=getlongint;
writeln([space,' Value length: ',len]);
if len > 0 then
@ -3793,7 +3858,8 @@ begin
end;
if has_errors then
Halt(1);
if error_on_more and has_more_infos then
if error_on_more and
(has_more_infos or has_warnings) then
Halt(2);
end.