diff --git a/compiler/scandir.pas b/compiler/scandir.pas index ab04164209..37b34485cc 100644 --- a/compiler/scandir.pas +++ b/compiler/scandir.pas @@ -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 diff --git a/compiler/scanner.pas b/compiler/scanner.pas index 43d5e95d54..4065da6080 100644 --- a/compiler/scanner.pas +++ b/compiler/scanner.pas @@ -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