File: unitdiff.pp

package info (click to toggle)
fpc 3.0.0%2Bdfsg-11%2Bdeb9u1
  • links: PTS, VCS
  • area: main
  • in suites: stretch
  • size: 273,420 kB
  • ctags: 106,632
  • sloc: pascal: 2,840,574; xml: 152,225; ansic: 9,635; asm: 8,297; java: 5,346; sh: 3,991; yacc: 3,745; php: 3,281; makefile: 2,635; lex: 2,538; sql: 267; cpp: 145; perl: 134; sed: 132; csh: 34; tcl: 7
file content (340 lines) | stat: -rw-r--r-- 8,801 bytes parent folder | download | duplicates (5)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
{

    UnitDiff Copyright (C) 2004 by the Free Pascal team

    Show differences between unit interfaces.

    See the file COPYING, included in this distribution,
    for details about the copyright.

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

{$mode objfpc}
{$h+}

program unitdiff;

uses
  SysUtils, Classes, Gettext,
  dGlobals, PasTree, PParser,PScanner;

resourcestring
  SIdentifiersIn = 'Identifiers in file "%s"';
  SCmdLineInvalidOption = 'Ignoring unknown option "%s"';
  SErrNoInputFile = 'No input file specified';
  SWarnAssumingList = 'Only one input file specified. Assuming --list option.';
  SExtraIdentifier = 'Extra identifier in file "%s" : Name: %s';
  SExtraTypedIdentifier = 'Extra identifier in file "%s" : Type %s, Name: %s';
  SIdenticalUnits = 'Unit interfaces are identical.';

type
  TCmdLineAction = (actionHelp, actionDiff,ActionList);

  TSkelEngine = class(TFPDocEngine)
  public
    FList: TStringList;
    Constructor Create;
    Destructor Destroy;override;
    function CreateElement(AClass: TPTreeElement; const AName: String;
      AParent: TPasElement; AVisibility :TPasMemberVisibility;
      const ASourceFilename: String; ASourceLinenumber: Integer): TPasElement; override;
  end;

Constructor TSkelEngine.Create;
begin
  Inherited Create;
  FList:=TStringList.Create;
end;

Destructor TSkelEngine.Destroy;

begin
  FreeAndNil(FList);
  Inherited;
end;

const
  CmdLineAction: TCmdLineAction = actionDiff;
  OSTarget: String = {$I %FPCTARGETOS%};
  CPUTarget: String = {$I %FPCTARGETCPU%};

var
  InputFile1,
  InputFile2 : String;
  DocLang: String;
  Engine1,
  Engine2: TSkelEngine;
  SparseList,
  DisableArguments,
  DisableProtected,
  DisablePrivate,
  DisableFunctionResults: Boolean;

  OutputName: String;
  f: Text;


function TSkelEngine.CreateElement(AClass: TPTreeElement; const AName: String;
  AParent: TPasElement; AVisibility : TPasMemberVisibility;
  const ASourceFilename: String; ASourceLinenumber: Integer): TPasElement;

  Function ExamineThisNode(APasElement : TPasElement)  : Boolean;

  begin
    Result:=Assigned(AParent) and (Length(AName) > 0) and
            (not DisableArguments or (APasElement.ClassType <> TPasArgument)) and
            (not DisableFunctionResults or (APasElement.ClassType <> TPasResultElement)) and
            (not DisablePrivate or (AVisibility<>visPrivate)) and
            (not DisableProtected or (AVisibility<>visProtected));
  end;

begin
  Result := AClass.Create(AName, AParent);
  if AClass.InheritsFrom(TPasModule) then
    CurModule := TPasModule(Result)
  else if ExamineThisNode(Result) then
    Flist.AddObject(Result.FullName,Result);
end;


Procedure Usage;

begin
  Writeln('Usage : ',ExtractFileName(Paramstr(0)),' [options] file1 file2');
  Writeln('Where [options] is one or more of :');
  Writeln(' --disable-arguments Do not check function arguments.');
  Writeln(' --disable-private   Do not check class private fields.');
  Writeln(' --disable-protected Do not check class protected fields.');
  Writeln(' --help              Emit help.');
  Writeln(' --input=cmdline     Input file to create skeleton for.');
  Writeln('                     Use options are as for compiler.');
  Writeln(' --lang=language     Use selected language.');
  Writeln(' --list              List identifiers instead of making a diff');
  Writeln(' --output=filename   Send output to file.');
  Writeln(' --sparse            Sparse list/diff (skip type identification)');
end;

procedure ParseOption(const s: String);

var
  i: Integer;
  Cmd, Arg: String;
begin
  if (s = '-h') or (s = '--help') then
    CmdLineAction := actionHelp
  else if s = '--disable-arguments' then
    DisableArguments := True
  else if s = '--disable-private' then
    DisablePrivate := True
  else if s = '--sparse' then
    SparseList := True
  else if s = '--disable-protected' then
    begin
    DisableProtected := True;
    DisablePrivate :=True;
    end
  else
    begin
    i := Pos('=', s);
    if i > 0 then
      begin
      Cmd := Copy(s, 1, i - 1);
      Arg := Copy(s, i + 1, Length(s));
      end
    else
      begin
      Cmd := s;
      SetLength(Arg, 0);
      end;
    if (Cmd = '-l') or (Cmd = '--lang') then
      DocLang := Arg
    else if (Cmd = '-o') or (Cmd = '--output') then
      OutputName := Arg
    else
      if (length(cmd)>0) and (cmd[1]='-') then
         WriteLn(StdErr, Format(SCmdLineInvalidOption, [s]))
      else if (InputFile1='') then
        InputFile1:=Cmd
      else if (InputFile2='') then
        InputFile2:=Cmd
      else
        WriteLn(StdErr, Format(SCmdLineInvalidOption, [s]));
  end;
end;

procedure ParseCommandLine;

Const
{$IFDEF Unix}
  MoFileTemplate = '/usr/share/locale/%s/LC_MESSAGES/makeskel-' + {$include %FPCVERSION%} + '.mo';
{$ELSE}
  MoFileTemplate ='intl/makeskel.%s.mo';
{$ENDIF}

var
  MOFilename: string;
  i: Integer;
begin
  CmdLineAction := actionDiff;
  DocLang:='';
  SparseList:=False;
  for i := 1 to ParamCount do
    ParseOption(ParamStr(i));
  If (DocLang<>'') then
    begin
    MOFilename:=Format(MOFileTemplate,[DocLang]);
    if FileExists(MOFilename) then
      gettext.TranslateResourceStrings(MoFileName)
    else
      writeln('NOTE: unable to find translation file ',MOFilename);
    // Translate internal documentation strings
    TranslateDocStrings(DocLang);
    end;
  if (cmdLineAction<>ActionHelp) and (InputFile1='') and (InputFile2='') then
  begin
    Writeln(StdErr,SErrNoInputFile);
    cmdLineAction := actionHelp;
  end else if (InputFile2='') and (CmdLineAction<>ActionList) then
    begin
    Writeln(StdErr,SWarnAssumingList);
    CmdLineAction:=ActionList;
    end;
end;

Function GetTypeDescription(El : TPasElement) : String;

begin
  If Assigned(El) then
    Result:=El.ElementTypeName
  else
    Result:='(unknown)';
end;

Procedure ListIdentifiers(Fn : String; List : TStrings);

Var
  I : Integer;

begin
  Writeln(f,Format(SIdentifiersIn,[FN]));
  For I:=0 to List.Count-1 do
    begin
    If Not SparseList then
      Write(GetTypeDescription(TPasElement(List.Objects[i])),' : ');
    Writeln(List[i]);
    end;
end;

Procedure WriteExtra(FN,Id : String; El: TPaselement);

begin
  If SparseList then
     Writeln(F,Format(SExtraIdentifier,[FN,ID]))
  else
     Writeln(F,Format(SExtraTypedIdentifier,[FN,GetTypeDescription(El),ID]));
end;

Procedure DoExtra(FN : String; L : TStrings);

Var
  I,Len : Integer;
  S : String;

begin
  I:=0;
  While (I<L.Count) do
    begin
    WriteExtra(FN,L[I],TPasElement(L.Objects[I]));
    // Delete possible subelements.
    S:=L[I]+'.';
    Len:=Length(S);
    While (I+1<L.Count) and (CompareText(Copy(L[I+1],1,Len),S)=0) do
      L.Delete(I+1);
    Inc(I);
    end;
end;

Procedure DiffIdentifiers(List1,List2 : TStrings);

Var
  L1,L2 : TStrings;
  I,J : Integer;

begin
  L1:=List1;
  L2:=List2;
  If List2.Count>List1.Count then
    begin
    L1:=List2;
    L2:=List1;
    end;
  // Remove all common elements.
  For I:=L1.Count-1 downto 0 do
    begin
    J:=L2.IndexOf(L1[i]);
    If (J<>-1) then
      begin
      L1.Delete(I);
      L2.Delete(J);
      end;
    end;
  If (List1.Count=0) and (List2.Count=0) then
    Writeln(F,SIdenticalUnits)
  else
    begin
    DoExtra(InputFile1,List1);
    DoExtra(InputFile2,List2);
    end;
end;


begin
  ParseCommandLine;
  if CmdLineAction = actionHelp then
    Usage
  else
    begin
    Assign(f, OutputName);
    Rewrite(f);
    Try
      Engine1:=TSkelEngine.Create;
      Try
        try
          Engine1.SetPackageName('diff'); // do not localize
          ParseSource(Engine1, InputFile1, OSTarget, CPUTarget);
          Engine1.FList.Sorted:=True;
          if (InputFile2<>'') then
            begin
              Engine2:=TSkelEngine.Create;
              Try
                Engine2.SetPackageName('diff'); // do not localize
                ParseSource(Engine2, InputFile2, OSTarget, CPUTarget);
                Engine2.FList.Sorted:=True;
                If cmdLineAction=ActionList then
                  begin
                  ListIdentifiers(InputFile1,Engine1.FList);
                  ListIdentifiers(InputFile2,Engine2.FList);
                  end
                else
                  DiffIdentifiers(Engine1.Flist,Engine2.Flist);
              finally
                Engine2.Free;
              end;
            end
          else
            ListIdentifiers(InputFile1,Engine1.FList);
        except
          on e: eparsererror do
            writeln(format('%s(%d,%d): Error: %s',[e.Filename,e.Row,e.Column,e.Message]));
        end;
      Finally
        Engine1.Free;
      end;
    Finally
      Close(f);
    end;
    end;
end.