* $message directive compatible with delphi

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

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