paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-12-04 03:37:35 +01:00
Code Issues Packages Projects Releases Wiki Activity

* $message directive compatible with delphi

Browse Source
This commit is contained in:
peter 2004-05-19 23:29:56 +00:00
parent c25228226d
commit 06448271ff
2 changed files with 93 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

48
compiler/scandir.pas
View File

@ -510,11 +510,52 @@ implementation
end;
end;
procedure dir_message;
var
hs : string;
w : longint;
begin
do_message(scan_i_user_defined);
w:=0;
current_scanner.skipspace;
{ Message level specified? }
if c='''' then
w:=scan_n_user_defined
else
begin
hs:=current_scanner.readid;
if (hs='WARN') or (hs='WARNING') then
w:=scan_w_user_defined
else
if (hs='ERROR') then
w:=scan_e_user_defined
else
if (hs='FATAL') then
w:=scan_f_user_defined
else
if (hs='HINT') then
w:=scan_h_user_defined
else
if (hs='NOTE') then
w:=scan_n_user_defined
else
Message1(scan_w_illegal_directive,hs);
end;
{ Only print message when there was no error }
if w<>0 then
begin
current_scanner.skipspace;
if c='''' then
hs:=current_scanner.readquotedstring
else
hs:=current_scanner.readcomment;
Message1(w,hs);
end
else
current_scanner.readcomment;
end;
procedure dir_mode;
begin
if not current_module.in_global then
@ -1003,7 +1044,10 @@ implementation
end.
{
$Log$
Revision 1.34 2004-05-11 22:51:34 olle
Revision 1.35 2004-05-19 23:29:56 peter
* $message directive compatible with delphi
Revision 1.34 2004/05/11 22:51:34 olle
* Performanceimprovement
Revision 1.33 2004/05/11 18:30:50 olle

48
compiler/scanner.pas
View File

@ -144,6 +144,7 @@ interface
function readval:longint;
function readval_asstring:string;
function readcomment:string;
function readquotedstring:string;
function readstate:char;
procedure skipspace;
procedure skipuntildirective;
@ -1862,6 +1863,48 @@ implementation
end;
function tscannerfile.readquotedstring:string;
var
i : longint;
msgwritten : boolean;
begin
i:=0;
msgwritten:=false;
if (c='''') then
begin
repeat
readchar;
case c of
#26 :
end_of_file;
#10,#13 :
Message(scan_f_string_exceeds_line);
'''' :
begin
readchar;
if c<>'''' then
break;
end;
end;
if i<255 then
begin
inc(i);
result[i]:=c;
end
else
begin
if not msgwritten then
begin
Message(scan_e_string_exceeds_255_chars);
msgwritten:=true;
end;
end;
until false;
end;
result[0]:=chr(i);
end;
function tscannerfile.readstate:char;
var
state : char;
@ -3067,7 +3110,10 @@ exit_label:
end.
{
$Log$
Revision 1.77 2004-05-16 13:55:26 peter
Revision 1.78 2004-05-19 23:29:56 peter
* $message directive compatible with delphi
Revision 1.77 2004/05/16 13:55:26 peter
* report about illegal chars in preproctoken instead of end of
expression
* support realnumbers in preproctoken parser