paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-15 23:59:30 +02:00
Code Issues Packages Projects Releases Wiki Activity

Implement support for $WARN XXX ON/OFF/ERROR

Browse Source 
* 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 -
This commit is contained in:
pierre 2011-06-28 10:03:07 +00:00
parent 3fd3cc8099
commit d09389ac79
7 changed files with 164 additions and 15 deletions

68
compiler/cmsgs.pas
View File

@ -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;
result:=true;
if (nr mod 1000 < msgidxmax[i]) then
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.

4
compiler/globals.pas
View File

@ -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)}

28
compiler/globtype.pas
View File

@ -517,10 +517,32 @@ interface
type
{ a message state }
tmsgstate = (
ms_on, // turn on output
ms_off, // turn off output
ms_error // cast to error
ms_on := 1,
ms_off := 2,
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

5
compiler/parser.pas
View File

@ -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;

8
compiler/scandir.pas
View File

@ -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;

23
compiler/switches.pas
View File

@ -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

43
compiler/verbose.pas
View File

@ -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;