paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-06 19:10:18 +02:00
Code Issues Packages Projects Releases Wiki Activity

fpc: compiler:

Browse Source 
- 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 -
This commit is contained in:
paul 2010-01-27 06:59:58 +00:00
parent 8ef245699a
commit a8381c8b32
9 changed files with 655 additions and 554 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
compiler/cmsgs.pas
View File

@ -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);
@ -380,26 +394,12 @@ var
hp: pchar;
i, txtbegin: longint;
begin
result:=false;
if ((nr div 1000) < low(msgidx)) or
((nr div 1000) > msgparts) then
result:=false;
i:=nr div 1000;
if (i < low(msgstates)) or
(i > msgparts) then
exit;
hp := GetPChar(nr);
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]:='_';
msgstates[i]^[nr mod 1000]:=ms_off;
result:=true;
end;

2
compiler/comphook.pas
View File

@ -76,7 +76,7 @@ type
currentsource : string; { filename }
currentline,
currentcolumn : longint; { current line and column }
currentmodulestate : string[20];
currentmodulestate : string[20];
{ Total Status }
compiledlines : longint; { the number of lines which are compiled }
errorcount,

8
compiler/globtype.pas
View File

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

6
compiler/msg/errore.msg
View File

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

5
compiler/msgidx.inc
View File

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

983
compiler/msgtxt.inc
View File

File diff suppressed because it is too large Load Diff

72
compiler/scandir.pas
View File

@ -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
begin
end
else if (upper(state)='OFF') 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
Message1(scanner_e_illegal_warn_state,state);
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;

5
compiler/switches.pas
View File

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

90
compiler/verbose.pas
View File

@ -179,7 +179,7 @@ implementation
function ClearMessageVerbosity(s: string; var i: integer): boolean;
var
tok : string;
tok : string;
code : longint;
msgnr: longint;
begin
@ -247,7 +247,7 @@ implementation
status.print_source_path:=true;
end;
'M' : if inverse or
not ClearMessageVerbosity(s, i) then
not ClearMessageVerbosity(s, i) then
begin
result:=false;
exit
@ -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,47 +575,58 @@ 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
v:=v or V_Error;
inc(status.errorcount);
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
else if st<>ms_off then
case ch of
'W':
begin
v:=v or V_Warning;
if CheckVerbosity(V_Warning) then
if status.errorwarning then
inc(status.errorcount)
else
inc(status.countWarnings);
end;
'N' :
begin
v:=v or V_Note;
if CheckVerbosity(V_Note) then
if status.errornote then
inc(status.errorcount)
else
inc(status.countNotes);
end;
'H' :
begin
v:=v or V_Hint;
if CheckVerbosity(V_Hint) then
if status.errorhint then
inc(status.errorcount)
else
inc(status.countHints);
end;
end;
end;
'O' :
v:=v or V_Normal;
'W':
begin
v:=v or V_Warning;
if CheckVerbosity(V_Warning) then
if status.errorwarning then
inc(status.errorcount)
else
inc(status.countWarnings);
end;
'N' :
begin
v:=v or V_Note;
if CheckVerbosity(V_Note) then
if status.errornote then
inc(status.errorcount)
else
inc(status.countNotes);
end;
'H' :
begin
v:=v or V_Hint;
if CheckVerbosity(V_Hint) then
if status.errorhint then
inc(status.errorcount)
else
inc(status.countHints);
end;
'I' :
v:=v or V_Info;
'L' :