fpc: compiler:

- complete $WARN switch parsing and add a stab to change message state
  - reimplement way of message hiding by -vm switch (by Dmitry Boyarintsev)
(note: $WARN switch does not work at the moment since state handling is not yet implemented)

git-svn-id: trunk@14809 -

compiler/cmsgs.pas

@@ -25,6 +25,9 @@ unit cmsgs;
 
 interface
 
+uses
+  globtype;
+
 const
   maxmsgidxparts = 20;
 
@@ -34,6 +37,9 @@ type
   TArrayOfPChar = array[0..1000] of pchar;
   PArrayOfPChar = ^TArrayOfPChar;
 
+  TArrayOfState = array[0..1000] of tmsgstate;
+  PArrayOfState = ^TArrayOfState;
+
   PMessage=^TMessage;
   TMessage=object
     msgfilename : string;
@@ -45,6 +51,7 @@ type
     msgtxt      : pchar;
     msgidx      : array[1..maxmsgidxparts] of PArrayOfPChar;
     msgidxmax   : array[1..maxmsgidxparts] of longint;
+    msgstates   : array[1..maxmsgidxparts] of PArrayOfState;
     constructor Init(n:longint;const idxmax:array of longint);
     destructor  Done;
     function  LoadIntern(p:pointer;n:longint):boolean;
@@ -109,8 +116,12 @@ begin
   for i:=1 to n do
    begin
      msgidxmax[i]:=idxmax[i-1];
+     { create array of msgidx }
      getmem(msgidx[i],msgidxmax[i]*sizeof(pointer));
      fillchar(msgidx[i]^,msgidxmax[i]*sizeof(pointer),0);
+     { create array of states }
+     getmem(msgstates[i],msgidxmax[i]*sizeof(tmsgstate));
+     fillchar(msgstates[i]^,msgidxmax[i]*sizeof(tmsgstate),0);
    end;
 end;
 
@@ -120,7 +131,10 @@ var
   i : longint;
 begin
   for i:=1 to msgparts do
+  begin
    freemem(msgidx[i],msgidxmax[i]*sizeof(pointer));
+   freemem(msgstates[i],msgidxmax[i]*sizeof(tmsgstate));
+  end;
   if msgallocsize>0 then
    begin
      freemem(msgtxt,msgsize);
@@ -381,25 +395,11 @@ var
   i, txtbegin: longint;
 begin
   result:=false;
-  if ((nr div 1000) < low(msgidx)) or
+  i:=nr div 1000;
-     ((nr div 1000) > msgparts) then
+  if (i < low(msgstates)) or
+     (i > msgparts) then
     exit;
-  hp := GetPChar(nr);
+  msgstates[i]^[nr mod 1000]:=ms_off;
-  if (hp=nil) then
-    exit;
-  txtbegin:=-1;
-  for i:=0 to 4 do
-    begin
-      if hp[i]=#0 then
-        exit;
-      if hp[i]='_' then
-        begin
-          txtbegin:=i;
-          break;
-        end;
-    end;
-  for i:=0 to txtbegin-1 do
-    hp[i]:='_';
   result:=true;
 end;
 

compiler/globtype.pas

@@ -477,6 +477,14 @@ interface
        link_smart   = $4;
        link_shared  = $8;
 
+    type
+      { a message state }
+      tmsgstate = (
+        ms_on,    // turn on output
+        ms_off,   // turn off output
+        ms_error  // cast to error
+      );
+
 implementation
 
 end.

compiler/msg/errore.msg

@@ -128,7 +128,7 @@ general_i_number_of_notes=01023_I_$1 note(s) issued
 #
 # Scanner
 #
-# 02086 is the last used one
+# 02087 is the last used one
 #
 % \section{Scanner messages.}
 % This section lists the messages that the scanner emits. The scanner takes
@@ -344,7 +344,7 @@ scan_w_minstacksize_not_support=02077_W_MINSTACKSIZE is not supported by the tar
 % The \var{\{\$MINSTACKSIZE\}} directive is not supported by the target OS.
 scan_w_maxstacksize_not_support=02078_W_MAXSTACKSIZE is not supported by the target OS
 % The \var{\{\$MAXSTACKSIZE\}} directive is not supported by the target OS.
-scanner_e_illegal_warn_state=02079_E_Illegal state for $WARN directive
+scanner_e_illegal_warn_state=02079_E_Illegal state "$1" for $WARN directive
 % Only ON and OFF can be used as state with a \var{\{\$WARN\}} compiler directive.
 scan_e_only_packset=02080_E_Illegal set packing value
 % Only 0, 1, 2, 4, 8, DEFAULT and NORMAL are allowed as packset parameters.
@@ -362,6 +362,8 @@ scan_e_illegal_minfpconstprec=02085_E_Illegal minimal floating point constant pr
 scan_w_multiple_main_name_overrides=02086_W_Overriding name of "main" procedure multiple times, was previously set to "$1"
 % The name for the main entry procedure is specified more than once. Only the last
 % name will be used.
+scanner_w_illegal_warn_identifier=02087_W_Illegal identifier "$1" for $WARN directive
+% Identifier is not known by a \var{\{\$WARN\}} compiler directive.
 % \end{description}
 #
 # Parser

compiler/msgidx.inc

@@ -106,6 +106,7 @@ const
   scan_w_frameworks_darwin_only=02084;
   scan_e_illegal_minfpconstprec=02085;
   scan_w_multiple_main_name_overrides=02086;
+  scanner_w_illegal_warn_identifier=02087;
   parser_e_syntax_error=03000;
   parser_e_dont_nest_interrupt=03004;
   parser_w_proc_directive_ignored=03005;
@@ -851,9 +852,9 @@ const
   option_info=11024;
   option_help_pages=11025;
 
-  MsgTxtSize = 55757;
+  MsgTxtSize = 55814;
 
   MsgIdxMax : array[1..20] of longint=(
-    24,87,287,95,80,51,110,22,202,63,
+    24,88,287,95,80,51,110,22,202,63,
     49,20,1,1,1,1,1,1,1,1
   );

compiler/scandir.pas

@@ -1176,24 +1176,84 @@ unit scandir;
     { delphi compatible warn directive:
       $warn <identifier> on
       $warn <identifier> off
+      $warn <identifier> error
       not implemented yet
     }
     procedure dir_warn;
       var
+        ident : string;
         state : string;
+        msgstate : tmsgstate;
       begin
         current_scanner.skipspace;
-        current_scanner.readid;
+        ident:=current_scanner.readid;
         current_scanner.skipspace;
         state:=current_scanner.readid;
-        if (upper(state)='ON') then
+
+        { support both delphi and fpc switches }
+        if (state='ON') or (state='+') then
+          msgstate:=ms_on
+        else
+        if (state='OFF') or (state='-') then
+          msgstate:=ms_off
+        else
+        if (state='ERROR') then
+          msgstate:=ms_error
+        else
         begin
-          end
+          Message1(scanner_e_illegal_warn_state,state);
-        else if (upper(state)='OFF') then
+          exit;
+        end;
+
+        if ident='CONSTRUCTING_ABSTRACT' then
+          recordpendingmessagestate(type_w_instance_with_abstract, msgstate)
+        else
+        if ident='IMPLICIT_VARIANTS' then
+          recordpendingmessagestate(parser_w_implicit_uses_of_variants_unit, msgstate)
+        else
+        if ident='NO_RETVAL' then
+          recordpendingmessagestate(sym_w_function_result_not_set, msgstate)
+        else
+        if ident='SYMBOL_DEPRECATED' then
           begin
+            recordpendingmessagestate(sym_w_deprecated_symbol, msgstate);
+            recordpendingmessagestate(sym_w_deprecated_symbol_with_msg, msgstate);
           end
         else
-          Message1(scanner_e_illegal_warn_state,state);
+        if ident='SYMBOL_EXPERIMENTAL' then
+          recordpendingmessagestate(sym_w_experimental_symbol, msgstate)
+        else
+        if ident='SYMBOL_LIBRARY' then
+          recordpendingmessagestate(sym_w_library_symbol, msgstate)
+        else
+        if ident='SYMBOL_PLATFORM' then
+          recordpendingmessagestate(sym_w_non_portable_symbol, msgstate)
+        else
+        if ident='SYMBOL_UNIMPLEMENTED' then
+          recordpendingmessagestate(sym_w_non_implemented_symbol, msgstate)
+        else
+        if ident='UNIT_DEPRECATED' then
+          begin
+            recordpendingmessagestate(sym_w_deprecated_unit, msgstate);
+            recordpendingmessagestate(sym_w_deprecated_unit_with_msg, msgstate);
+          end
+        else
+        if ident='UNIT_EXPERIMENTAL' then
+          recordpendingmessagestate(sym_w_experimental_unit, msgstate)
+        else
+        if ident='UNIT_LIBRARY' then
+          recordpendingmessagestate(sym_w_library_unit, msgstate)
+        else
+        if ident='UNIT_PLATFORM' then
+          recordpendingmessagestate(sym_w_non_portable_unit, msgstate)
+        else
+        if ident='UNIT_UNIMPLEMENTED' then
+          recordpendingmessagestate(sym_w_non_implemented_unit, msgstate)
+        else
+        if ident='ZERO_NIL_COMPAT' then
+          recordpendingmessagestate(type_w_zero_to_nil, msgstate)
+        else
+          Message1(scanner_w_illegal_warn_identifier,ident);
       end;
 
     procedure dir_warning;

compiler/switches.pas

@@ -32,6 +32,7 @@ procedure HandleSwitch(switch,state:char);
 function CheckSwitch(switch,state:char):boolean;
 
 procedure recordpendingverbosityswitch(sw: char; state: char);
+procedure recordpendingmessagestate(msg: longint; state: tmsgstate);
 procedure recordpendinglocalswitch(sw: tlocalswitch; state: char);
 procedure recordpendinglocalfullswitch(const switches: tlocalswitches);
 procedure recordpendingverbosityfullswitch(verbosity: longint);
@@ -263,6 +264,10 @@ procedure recordpendingverbosityswitch(sw: char; state: char);
     pendingstate.nextverbositystr:=pendingstate.nextverbositystr+sw+state;
   end;
 
+procedure recordpendingmessagestate(msg: longint; state: tmsgstate);
+  begin
+    { todo }
+  end;
 
 procedure recordpendinglocalswitch(sw: tlocalswitch; state: char);
   begin

compiler/verbose.pas

@@ -542,12 +542,25 @@ implementation
          end;
       end;
 
+    function GetMessageState(m:longint):tmsgstate;
+      var
+        i: integer;
+      begin
+        i:=m div 1000;
+        { get the default state }
+        Result:=msg^.msgstates[i]^[m mod 1000];
+
+        { and search at the current unit settings }
+        { todo }
+      end;
 
     Procedure Msg2Comment(s:ansistring;w:longint;onqueue:tmsgqueueevent);
       var
         idx,i,v : longint;
         dostop  : boolean;
         doqueue : boolean;
+        st      : tmsgstate;
+        ch      : char;
       begin
       {Reset}
         dostop:=false;
@@ -562,20 +575,27 @@ implementation
           begin
             for i:=1 to idx do
              begin
-               case upcase(s[i]) of
+               ch:=upcase(s[i]);
+               case ch of
                 'F' :
                   begin
                     v:=v or V_Fatal;
                     inc(status.errorcount);
                     dostop:=true;
                   end;
-                'E' :
+                'E','W','N','H':
+                  begin
+                    if ch='E' then
+                      st:=ms_error
+                    else
+                      st:=GetMessageState(w);
+                    if st=ms_error then
                       begin
                         v:=v or V_Error;
                         inc(status.errorcount);
-                  end;
+                      end
-                'O' :
+                    else if st<>ms_off then
-                  v:=v or V_Normal;
+                      case ch of
                        'W':
                          begin
                            v:=v or V_Warning;
@@ -603,6 +623,10 @@ implementation
                              else
                               inc(status.countHints);
                          end;
+                      end;
+                  end;
+                'O' :
+                  v:=v or V_Normal;
                 'I' :
                   v:=v or V_Info;
                 'L' :