1 {
2  ***************************************************************************
3  *                                                                         *
4  *   This source is free software; you can redistribute it and/or modify   *
5  *   it under the terms of the GNU General Public License as published by  *
6  *   the Free Software Foundation; either version 2 of the License, or     *
7  *   (at your option) any later version.                                   *
8  *                                                                         *
9  *   This code is distributed in the hope that it will be useful, but      *
10  *   WITHOUT ANY WARRANTY; without even the implied warranty of            *
11  *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *
12  *   General Public License for more details.                              *
13  *                                                                         *
14  *   A copy of the GNU General Public License is available on the World    *
15  *   Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also      *
16  *   obtain it by writing to the Free Software Foundation,                 *
17  *   Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA.   *
18  *                                                                         *
19  ***************************************************************************
20 
21   Author: Mattias Gaertner
22 
23   Abstract:
24     Demo for parsing fpc compiler/msg/error*.msg files.
25 }
26 program parsefpcmsg;
27 
28 {$mode objfpc}{$H+}
29 
30 uses
31   SysUtils, FileProcs, CodeToolManager, CodeCache, CodeToolsFPCMsgs,
32   LazFileUtils, LazUTF8;
33 
34 var
35   Code: TCodeBuffer;
36   Filename: String;
37   MsgFile: TFPCMsgFile;
38   i: Integer;
39   Found: TFPCMsgItem;
40   Item: TFPCMsgItem;
41   Msg: String;
42   s: TfmiSpecialItem;
43 begin
44   if Paramcount<>1 then begin
45     writeln('Usage: '+ParamStr(0)+' fpc_file_errore.msg');
46     writeln(ParamCount);
47     Halt;
48   end;
49   Filename:=TrimAndExpandFilename(ParamStrUTF8(1));
50 
51   // load the file
52   Code:=CodeToolBoss.LoadFile(Filename,false,false);
53   if Code=nil then
54     raise Exception.Create('unable to read '+Filename);
55 
56   MsgFile:=TFPCMsgFile.Create;
57   MsgFile.LoadFromText(Code.Source);
58   for s:=succ(fmisiNone) to high(TfmiSpecialItem) do
59     if MsgFile.SpecialItems[s]=nil then
60       raise Exception.Create('special message '+dbgs(s)+' is missing');
61 
62   // check a specific message
63   Item:=MsgFile.FindWithID(1009);
64   Msg:=MsgFile.GetMsgText(Item);
65   if MsgFile.PatternFits(Item,Msg)<0 then begin
66     writeln('message does not fit itself: ',Item.GetName,'="',Item.Pattern,'"');
67     writeln('Msg: ',Msg);
68     writeln('Fits=',MsgFile.PatternFits(Item,Msg));
69     raise Exception.Create('bug?');
70   end;
71 
72   for i:=0 to MsgFile.Count-1 do begin
73     Item:=MsgFile[i];
74     Msg:=MsgFile.GetMsgText(Item);
75     Found:=MsgFile.FindWithMessage(Msg);
76     if Found=nil then begin
77       // this should never happen
78       writeln('message does not fit itself: i=',i,
79         ' MsgFile[i]=',Item.GetName,'="',Item.Pattern,'"');
80       writeln('Msg: ',Msg);
81       writeln('Fits=',Item.PatternFits(Msg));
82       raise Exception.Create('bug?');
83     end else if Found<>Item then begin
84       writeln('message pattern is ambiguous: i=',i,
85         ' MsgFile[i]=',Item.GetName,'="',Item.Pattern,'"',
86         ' Other=',Found.GetName,'="',Found.Pattern,'"');
87     end;
88   end;
89   MsgFile.Free;
90 end.
91 
92