mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-06 11:48:10 +02:00
327 lines
7.4 KiB
ObjectPascal
327 lines
7.4 KiB
ObjectPascal
{
|
|
$Id$
|
|
Copyright (c) 1998 by the FPC development team
|
|
|
|
This unit handles the verbose management
|
|
|
|
This program is free software; you can redistribute it and/or modify
|
|
it under the terms of the GNU General Public License as published by
|
|
the Free Software Foundation; either version 2 of the License, or
|
|
(at your option) any later version.
|
|
|
|
This program is distributed in the hope that it will be useful,
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
GNU General Public License for more details.
|
|
|
|
You should have received a copy of the GNU General Public License
|
|
along with this program; if not, write to the Free Software
|
|
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|
|
|
|
****************************************************************************
|
|
}
|
|
unit verbose;
|
|
interface
|
|
|
|
uses messages;
|
|
|
|
{$define allow_oldstyle}
|
|
|
|
{$IFNDEF EXTERN_MSG}
|
|
{$i msgtxt.inc}
|
|
{$ENDIF}
|
|
|
|
{$i msgidx.inc}
|
|
|
|
Const
|
|
MaxErrorCount = 50;
|
|
{ <$100 can include file and linenr info }
|
|
V_Fatal = $0;
|
|
V_Error = $1;
|
|
V_Warning = $2;
|
|
V_Note = $4;
|
|
V_Hint = $8;
|
|
V_Info = $100;
|
|
V_Linenrs = $200;
|
|
V_Used = $400;
|
|
V_Tried = $800;
|
|
V_Macro = $1000;
|
|
V_Procedure = $2000;
|
|
V_Conditional = $4000;
|
|
V_Debug = $8000;
|
|
|
|
V_All = $ffffffff;
|
|
V_Default = V_Error;
|
|
|
|
Verbosity : longint=V_Default;
|
|
|
|
var
|
|
errorcount : longint; { number of generated errors }
|
|
msg : pmessage;
|
|
|
|
procedure LoadMsgFile(const fn:string);
|
|
function SetVerbosity(const s:string):boolean;
|
|
|
|
procedure stop;
|
|
procedure comment(l:longint;const s:string);
|
|
procedure internalerror(i:longint);
|
|
procedure Message(w:tmsgconst);
|
|
procedure Message1(w:tmsgconst;const s1:string);
|
|
procedure Message2(w:tmsgconst;const s1,s2:string);
|
|
procedure Message3(w:tmsgconst;const s1,s2,s3:string);
|
|
|
|
{ old calling style }
|
|
{$ifdef allow_oldstyle}
|
|
var
|
|
exterror : pchar;
|
|
procedure note(w:tmsgconst);
|
|
procedure warning(w:tmsgconst);
|
|
procedure error(w:tmsgconst);
|
|
procedure fatalerror(w:tmsgconst);
|
|
{$endif}
|
|
|
|
{ Function redirecting for IDE support }
|
|
type
|
|
tstopprocedure = procedure;
|
|
tcommentprocedure = procedure(Level:Longint;const s:string);
|
|
{old handlers }
|
|
terrorfunction = function(w:tmsgconst) : boolean;
|
|
tinternalerrorfunction = function(i : longint) : boolean;
|
|
var
|
|
{ this procedure is called to stop the compiler }
|
|
{ e.g. this procedure has to restore the state before compiling }
|
|
do_stop : tstopprocedure;
|
|
|
|
{ called when writing something to the screen, called with the level }
|
|
{ of the comment }
|
|
do_comment : tcommentprocedure;
|
|
|
|
{ only for compatibility }
|
|
do_note,do_warning,do_error,do_fatalerror : terrorfunction;
|
|
do_internalerror : tinternalerrorfunction;
|
|
|
|
|
|
implementation
|
|
uses globals;
|
|
|
|
|
|
procedure LoadMsgFile(const fn:string);
|
|
begin
|
|
if not (msg=nil) then
|
|
dispose(msg,Done);
|
|
msg:=new(pmessage,InitExtern(fn,ord(endmsgconst)));
|
|
end;
|
|
|
|
|
|
function SetVerbosity(const s:string):boolean;
|
|
var
|
|
m : Longint;
|
|
c : Word;
|
|
begin
|
|
setverbosity:=false;
|
|
val(s,m,c);
|
|
if (c=0) and (s<>'') then
|
|
verbosity:=m
|
|
else
|
|
begin
|
|
for c:=1 to length(s) do
|
|
case upcase(s[c]) of
|
|
{ Special cases }
|
|
'A' : Verbosity:=V_All;
|
|
'0' : Verbosity:=V_Default;
|
|
{ Normal cases - do an or }
|
|
'E' : Verbosity:=Verbosity or V_Error;
|
|
'I' : Verbosity:=Verbosity or V_Info;
|
|
'W' : Verbosity:=Verbosity or V_Warning;
|
|
'N' : Verbosity:=Verbosity or V_Note;
|
|
'H' : Verbosity:=Verbosity or V_Hint;
|
|
'L' : Verbosity:=Verbosity or V_Linenrs;
|
|
'U' : Verbosity:=Verbosity or V_Used;
|
|
'T' : Verbosity:=Verbosity or V_Tried;
|
|
'M' : Verbosity:=Verbosity or V_Macro;
|
|
'P' : Verbosity:=Verbosity or V_Procedure;
|
|
'C' : Verbosity:=Verbosity or V_Conditional;
|
|
'D' : Verbosity:=Verbosity or V_Debug;
|
|
end;
|
|
end;
|
|
setverbosity:=true;
|
|
end;
|
|
|
|
|
|
|
|
procedure stop;
|
|
begin
|
|
{$ifndef TP}
|
|
do_stop();
|
|
{$else}
|
|
do_stop;
|
|
{$endif}
|
|
end;
|
|
|
|
|
|
procedure internalerror(i : longint);
|
|
begin
|
|
do_internalerror(i);
|
|
stop;
|
|
end;
|
|
|
|
|
|
procedure Comment(l:longint;const s:string);
|
|
begin
|
|
do_comment(l,s);
|
|
end;
|
|
|
|
|
|
Procedure Msg2Comment(s:string);
|
|
var
|
|
idx,i,v : longint;
|
|
dostop : boolean;
|
|
begin
|
|
{Reset}
|
|
dostop:=false;
|
|
v:=0;
|
|
{Parse options}
|
|
idx:=pos('_',s);
|
|
if idx=0 then
|
|
v:=V_Default
|
|
else
|
|
if (idx in [1..5]) then
|
|
begin
|
|
for i:=1to idx do
|
|
begin
|
|
case upcase(s[i]) of
|
|
'F' : begin
|
|
v:=v or V_Fatal;
|
|
dostop:=true;
|
|
end;
|
|
'E' : begin
|
|
v:=v or V_Error;
|
|
inc(errorcount);
|
|
dostop:=(errorcount>maxerrorcount);
|
|
end;
|
|
'W' : v:=v or V_Warning;
|
|
'N' : v:=v or V_Note;
|
|
'H' : v:=v or V_Hint;
|
|
'I' : v:=v or V_Info;
|
|
'L' : v:=v or V_Linenrs;
|
|
'U' : v:=v or V_Used;
|
|
'T' : v:=v or V_Tried;
|
|
'M' : v:=v or V_Macro;
|
|
'P' : v:=v or V_Procedure;
|
|
'C' : v:=v or V_Conditional;
|
|
'D' : v:=v or V_Debug;
|
|
'S' : dostop:=true;
|
|
'_' : ;
|
|
end;
|
|
end;
|
|
end;
|
|
Delete(s,1,idx);
|
|
Comment(v,s);
|
|
if dostop then
|
|
stop;
|
|
end;
|
|
|
|
|
|
procedure Message(w:tmsgconst);
|
|
begin
|
|
Msg2Comment(msg^.Get(ord(w)));
|
|
end;
|
|
|
|
|
|
procedure Message1(w:tmsgconst;const s1:string);
|
|
begin
|
|
Msg2Comment(msg^.Get1(ord(w),s1));
|
|
end;
|
|
|
|
|
|
procedure Message2(w:tmsgconst;const s1,s2:string);
|
|
begin
|
|
Msg2Comment(msg^.Get2(ord(w),s1,s2));
|
|
end;
|
|
|
|
|
|
procedure Message3(w:tmsgconst;const s1,s2,s3:string);
|
|
begin
|
|
Msg2Comment(msg^.Get3(ord(w),s1,s2,s3));
|
|
end;
|
|
|
|
|
|
{*****************************************************************************
|
|
Old Style
|
|
*****************************************************************************}
|
|
|
|
{$ifdef allow_oldstyle}
|
|
|
|
procedure warning(w:tmsgconst);
|
|
begin
|
|
if do_warning(w) then
|
|
stop;
|
|
end;
|
|
|
|
|
|
procedure note(w:tmsgconst);
|
|
begin
|
|
if do_note(w) then
|
|
stop;
|
|
end;
|
|
|
|
|
|
procedure error(w:tmsgconst);
|
|
begin
|
|
inc(errorcount);
|
|
if do_error(w) then
|
|
stop;
|
|
end;
|
|
|
|
|
|
procedure fatalerror(w:tmsgconst);
|
|
begin
|
|
do_fatalerror(w);
|
|
stop;
|
|
end;
|
|
|
|
{$endif}
|
|
|
|
begin
|
|
{$IFNDEF EXTERN_MSG}
|
|
msg:=new(pmessage,Init(@msgtxt,ord(endmsgconst)));
|
|
{$ENDIF}
|
|
end.
|
|
|
|
{
|
|
$Log$
|
|
Revision 1.1 1998-03-25 11:18:15 root
|
|
Initial revision
|
|
|
|
Revision 1.17 1998/03/10 16:43:34 peter
|
|
* fixed Fatal error writting
|
|
|
|
Revision 1.16 1998/03/10 01:17:30 peter
|
|
* all files have the same header
|
|
* messages are fully implemented, EXTDEBUG uses Comment()
|
|
+ AG... files for the Assembler generation
|
|
|
|
Revision 1.15 1998/03/06 00:53:02 peter
|
|
* replaced all old messages from errore.msg, only ExtDebug and some
|
|
Comment() calls are left
|
|
* fixed options.pas
|
|
|
|
Revision 1.14 1998/03/04 01:35:15 peter
|
|
* messages for unit-handling and assembler/linker
|
|
* the compiler compiles without -dGDB, but doesn't work yet
|
|
+ -vh for Hint
|
|
|
|
Revision 1.13 1998/03/03 16:45:25 peter
|
|
+ message support for assembler parsers
|
|
|
|
Revision 1.12 1998/03/02 16:02:05 peter
|
|
* new style messages for pp.pas
|
|
* cleanup of pp.pas
|
|
|
|
Revision 1.11 1998/03/02 01:49:40 peter
|
|
* renamed target_DOS to target_GO32V1
|
|
+ new verbose system, merged old errors and verbose units into one new
|
|
verbose.pas, so errors.pas is obsolete
|
|
|
|
}
|