Implement support for $WARN XXX ON/OFF/ERROR

* globtype.pas:
  tmsgstate updated (ms_on/off/error_global variants added).
  ms_local_mask, ms_global_mask : new constants.
  tmessagestaterecord: new record, use to list chains
  of local changes to warnings by $WARN directive.
  pmessagestaterecord: new pointer to tmessagestaterecord.

  * globals.pas:
    tsettings record:
    new field: pmessage of type pmessagestaterecord;

  * cmsgs.pas:
  TMessage class:
  New method: ResetStates; Called on unit parsing changes
  New Method: SetVerbosity(nr:longint;newstate:tmsgstate):boolean;
  Remember global state in
  replacing ClearVerbosity method.
  New boolean field:  has_local_changes
  set if a call to SetVerbosity makes a local change that must be
  reset when changing unit.

  * verbose.pas:
  New functions/procedures:
  function  SetMessageVerbosity(v:longint;state:tmsgstate):boolean;
  for changes caused by $WARN or option
  procedure RestoreLocalVerbosity(pstate : pmessagestaterecord);
  procedure FreeLocalVerbosity(var fstate : pmessagestaterecord);
  function ChangeMessageVerbosity(s: string; var i: integer;state:tmsgstate): boolean;

  * switches.pas:
  Implement recordpendingmessagestate
  flushpendingswitchesstate: Handle new pmessage field of
  current_settings record.

  * parser.pas:
  Handle pmessage field of current_settings.

  * scandir.pas:

  Handle also integer constants in $WARN.

git-svn-id: trunk@17852 -

compiler/cmsgs.pas

@@ -53,14 +53,18 @@ type
     msgidx      : array[1..maxmsgidxparts] of PArrayOfPChar;
     msgidxmax   : array[1..maxmsgidxparts] of longint;
     msgstates   : array[1..maxmsgidxparts] of PArrayOfState;
+    { set if changes with $WARN need to be cleared at next module change }
+    has_local_changes : boolean;
     constructor Init(n:longint;const idxmax:array of longint);
     destructor  Done;
     function  LoadIntern(p:pointer;n:longint):boolean;
     function  LoadExtern(const fn:string):boolean;
     procedure ClearIdx;
+    procedure ResetStates;
     procedure CreateIdx;
     function  GetPChar(nr:longint):pchar;
-    function  ClearVerbosity(nr:longint):boolean;
+    { function  ClearVerbosity(nr:longint):boolean; not used anymore }
+    function  SetVerbosity(nr:longint;newstate:tmsgstate):boolean;
     function  Get(nr:longint;const args:array of TMsgStr):ansistring;
   end;
 
@@ -107,9 +111,10 @@ end;
 
 constructor TMessage.Init(n:longint;const idxmax:array of longint);
 var
-  i : longint;
+  i,j : longint;
 begin
   msgtxt:=nil;
+  has_local_changes:=false;
   msgsize:=0;
   msgparts:=n;
   if n<>high(idxmax)+1 then
@@ -122,7 +127,9 @@ begin
      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);
+     { default value for msgstate is ms_on_global }
+     for j:=0 to msgidxmax[i]-1 do
+       msgstates[i]^[j]:=ms_on_global;
    end;
 end;
 
@@ -387,31 +394,76 @@ end;
 
 function TMessage.GetPChar(nr:longint):pchar;
 begin
-  GetPChar:=msgidx[nr div 1000]^[nr mod 1000];
+  if (nr div 1000 < msgparts) and
+     (nr mod 1000 <  msgidxmax[nr div 1000]) then
+    GetPChar:=msgidx[nr div 1000]^[nr mod 1000]
+  else
+    GetPChar:='';
 end;
 
-function TMessage.ClearVerbosity(nr:longint):boolean;
+function TMessage.SetVerbosity(nr:longint;newstate:tmsgstate):boolean;
 var
   i: longint;
+  oldstate : tmsgstate;
+  is_global : boolean;
 begin
   result:=false;
   i:=nr div 1000;
   if (i < low(msgstates)) or
      (i > msgparts) then
     exit;
-  msgstates[i]^[nr mod 1000]:=ms_off;
+  if (nr mod 1000 < msgidxmax[i]) then
-  result:=true;
+    begin
+      is_global:=(ord(newstate) and ms_global_mask) <> 0;
+      oldstate:=msgstates[i]^[nr mod 1000];
+      if not is_global then
+        newstate:= tmsgstate((ord(newstate) and ms_local_mask) or (ord(oldstate) and ms_global_mask));
+      if newstate<>oldstate then
+        has_local_changes:=true;
+      msgstates[i]^[nr mod 1000]:=newstate;
+      result:=true;
+    end;
 end;
 
+{
+function TMessage.ClearVerbosity(nr:longint):boolean;
+begin
+  ClearVerbosity:=SetVerbosity(nr,ms_off);
+end;
+}
+
 function TMessage.Get(nr:longint;const args:array of TMsgStr):ansistring;
 var
   hp : pchar;
 begin
-  hp:=msgidx[nr div 1000]^[nr mod 1000];
+  if (nr div 1000 < msgparts) and
+     (nr mod 1000 <  msgidxmax[nr div 1000]) then
+    hp:=msgidx[nr div 1000]^[nr mod 1000]
+  else
+    hp:=nil;
   if hp=nil then
     Get:='msg nr '+tostr(nr)
   else
     Get:=MsgReplace(system.strpas(hp),args);
 end;
 
+procedure TMessage.ResetStates;
+var
+  i,j,glob : longint;
+  state : tmsgstate;
+begin
+  if not has_local_changes then
+    exit;
+  for i:=1 to msgparts do
+    for j:=0 to msgidxmax[i] - 1 do
+      begin
+        state:=msgstates[i]^[j];
+        glob:=(ord(state) and ms_global_mask) shr ms_shift;
+        state:=tmsgstate((glob shl ms_shift) or glob);
+        msgstates[i]^[j]:=state;
+      end;
+  has_local_changes:=false;
+end;
+
+
 end.

compiler/globals.pas

@@ -138,6 +138,7 @@ interface
          minfpconstprec  : tfloattype;
 
          disabledircache : boolean;
+         pmessage : pmessagestaterecord;
 
         { CPU targets with microcontroller support can add a controller specific unit }
 {$if defined(ARM) or defined(AVR)}
@@ -176,11 +177,13 @@ interface
         property items[I:longint]:TLinkRec read getlinkrec; default;
       end;
 
+
       tpendingstate = record
         nextverbositystr : shortstring;
         nextlocalswitches : tlocalswitches;
         nextverbosityfullswitch: longint;
         nextcallingstr : shortstring;
+        nextmessagerecord : pmessagestaterecord;
         verbosityfullswitched,
         localswitcheschanged : boolean;
       end;
@@ -426,6 +429,7 @@ interface
         minfpconstprec : s32real;
 
         disabledircache : false;
+        pmessage : nil;
 {$if defined(ARM)}
         controllertype : ct_none;
 {$endif defined(ARM)}

compiler/globtype.pas

@@ -517,10 +517,32 @@ interface
     type
       { a message state }
       tmsgstate = (
-        ms_on,    // turn on output
+        ms_on := 1,
-        ms_off,   // turn off output
+        ms_off := 2,
-        ms_error  // cast to error
+        ms_error := 3,
+
+        ms_on_global := $11,    // turn on output
+        ms_off_global := $22,   // turn off output
+        ms_error_global := $33  // cast to error
       );
+    const
+      { Mask for current value of message state }
+      ms_local_mask = $0f;
+      { Mask for global value of message state
+        that needs to be restored when changing units }
+      ms_global_mask = $f0;
+      { Shift used to convert global to local message state }
+      ms_shift = 4;
+
+    type
+      pmessagestaterecord = ^tmessagestaterecord;
+      tmessagestaterecord = record
+        next : pmessagestaterecord;
+        value : longint;
+        state : tmsgstate;
+      end;
+
+
 
 implementation
 

compiler/parser.pas

@@ -351,6 +351,7 @@ implementation
          current_exceptblock:=0;
          exceptblockcounter:=0;
          current_settings.maxfpuregisters:=-1;
+         current_settings.pmessage:=nil;
        { reset the unit or create a new program }
          { a unit compiled at command line must be inside the loaded_unit list }
          if (compile_level=1) then
@@ -481,6 +482,8 @@ implementation
                 current_procinfo:=oldcurrent_procinfo;
                 current_filepos:=oldcurrent_filepos;
                 current_settings:=old_settings;
+                { Restore all locally modified warning messages }
+                RestoreLocalVerbosity(current_settings.pmessage);
                 current_exceptblock:=0;
                 exceptblockcounter:=0;
               end;
@@ -518,6 +521,8 @@ implementation
            dec(compile_level);
            set_current_module(olddata^.old_current_module);
 
+           FreeLocalVerbosity(current_settings.pmessage);
+
            dispose(olddata);
          end;
     end;

compiler/scandir.pas

@@ -1206,6 +1206,7 @@ unit scandir;
         ident : string;
         state : string;
         msgstate : tmsgstate;
+        i : integer;
       begin
         current_scanner.skipspace;
         ident:=current_scanner.readid;
@@ -1213,6 +1214,7 @@ unit scandir;
         state:=current_scanner.readid;
 
         { support both delphi and fpc switches }
+        { use local ms_on/off/error tmsgstate values }
         if (state='ON') or (state='+') then
           msgstate:=ms_on
         else
@@ -1275,7 +1277,11 @@ unit scandir;
         if ident='ZERO_NIL_COMPAT' then
           recordpendingmessagestate(type_w_zero_to_nil, msgstate)
         else
-          Message1(scanner_w_illegal_warn_identifier,ident);
+          begin
+            i:=0;
+            if not ChangeMessageVerbosity(ident,i,msgstate) then
+              Message1(scanner_w_illegal_warn_identifier,ident);
+          end;
       end;
 
     procedure dir_warning;

compiler/switches.pas

@@ -265,8 +265,14 @@ procedure recordpendingverbosityswitch(sw: char; state: char);
   end;
 
 procedure recordpendingmessagestate(msg: longint; state: tmsgstate);
+  var
+    pstate : pmessagestaterecord;
   begin
-    { todo }
+    new(pstate);
+    pstate^.next:=pendingstate.nextmessagerecord;
+    pstate^.value:=msg;
+    pstate^.state:=state;
+    pendingstate.nextmessagerecord:=pstate;
   end;
 
 procedure recordpendinglocalswitch(sw: tlocalswitch; state: char);
@@ -311,6 +317,7 @@ procedure recordpendingcallingswitch(const str: shortstring);
 procedure flushpendingswitchesstate;
   var
     tmpproccal: tproccalloption;
+    fstate, pstate : pmessagestaterecord;
   begin
     { process pending localswitches (range checking, etc) }
     if pendingstate.localswitcheschanged then
@@ -329,6 +336,20 @@ procedure flushpendingswitchesstate;
         setverbosity(pendingstate.nextverbositystr);
         pendingstate.nextverbositystr:='';
       end;
+    fstate:=pendingstate.nextmessagerecord;
+    pstate:=pendingstate.nextmessagerecord;
+    while assigned(pstate) do
+      begin
+        pendingstate.nextmessagerecord:=pstate^.next;
+        SetMessageVerbosity(pstate^.value,pstate^.state);
+        if not assigned(pstate^.next) then
+          begin
+            pstate^.next:=current_settings.pmessage;
+            current_settings.pmessage:=fstate;
+          end;
+        pstate:=pstate^.next;
+        pendingstate.nextmessagerecord:=nil;
+      end;
     { process pending calling convention changes (calling x) }
     if pendingstate.nextcallingstr<>'' then
       begin

compiler/verbose.pas

@@ -80,6 +80,11 @@ interface
     procedure PrepareReport;
 
     function  CheckVerbosity(v:longint):boolean;
+    function  SetMessageVerbosity(v:longint;state:tmsgstate):boolean;
+    procedure RestoreLocalVerbosity(pstate : pmessagestaterecord);
+    procedure FreeLocalVerbosity(var fstate : pmessagestaterecord);
+
+    function ChangeMessageVerbosity(s: string; var i: integer;state:tmsgstate): boolean;
     procedure ShowStatus;
     function  ErrorCount:longint;
     procedure SetErrorFlags(const s:string);
@@ -176,8 +181,29 @@ implementation
          writeln(status.reportbugfile,'FPC bug report file');
       end;
 
+    procedure RestoreLocalVerbosity(pstate : pmessagestaterecord);
+      begin
+        msg^.ResetStates;
+        while assigned(pstate) do
+          begin
+            SetMessageVerbosity(pstate^.value,pstate^.state);
+            pstate:=pstate^.next;
+          end;
+      end;
 
-    function ClearMessageVerbosity(s: string; var i: integer): boolean;
+    procedure FreeLocalVerbosity(var fstate : pmessagestaterecord);
+    var pstate : pmessagestaterecord;
+      begin
+        pstate:=fstate;
+        while assigned(pstate) do
+          begin
+            fstate:=pstate^.next;
+            freemem(pstate);
+            pstate:=fstate;
+          end;
+      end;
+
+    function ChangeMessageVerbosity(s: string; var i: integer;state:tmsgstate): boolean;
       var
         tok  : string;
         code : longint;
@@ -195,12 +221,23 @@ implementation
           val(tok, msgnr, code);
           if (code<>0) then
             exit;
-          if not msg^.clearverbosity(msgnr) then
+          if not msg^.setverbosity(msgnr,state) then
             exit;
         until false;
         result:=true;
       end;
 
+    { This function is only used for command line argument -vmXXX }
+    { thus the message needs to be cleared globally }
+    function ClearMessageVerbosity(s: string; var i: integer): boolean;
+      begin
+        ClearMessageVerbosity:=ChangeMessageVerbosity(s,i,ms_off_global);
+      end;
+
+    function SetMessageVerbosity(v:longint;state:tmsgstate):boolean;
+      begin
+        result:=msg^.setverbosity(v,state);
+      end;
 
     function CheckVerbosity(v:longint):boolean;
       begin
@@ -592,6 +629,8 @@ implementation
                       st:=ms_error
                     else
                       st:=GetMessageState(w);
+                    { We only want to know about local value }
+                    st:= tmsgstate(ord(st) and ms_local_mask);
                     if st=ms_error then
                       begin
                         v:=v or V_Error;