|
@@ -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);
|
|
|
- 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);
|
|
|
+ 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^);
|
|
|
+ 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.
|
|
|
|