← Back to branch summary

~ubuntu-branches/ubuntu/jaunty/adacontrol/jaunty

« back to all changes in this revision

Viewing changes to src/adactl_options.adb

  • Committer: Bazaar Package Importer
  • Author(s): Ludovic Brenta
  • Date: 2006-10-12 19:17:22 UTC
  • mfrom: (1.1.1 upstream)
  • Revision ID: james.westby@ubuntu.com-20061012191722-fo5bcn4k5r0iubgd
Tags: 1.5r24-1

* New upstream release.
* debian/control (Depends): add gnat-4.1.
  (Enhances): add gnat-gps.
* debian/adacontrol.gpr: build pfni.
* debian/rules: install the new gnat-gps plug-in, and pfni.
* debian/pfni.1: new.
* patches/gps-integration.patch: new.

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/adactl_options.adb
 
1
----------------------------------------------------------------------
 
2
--  Adactl_Options - Package body                                   --
 
3
--                                                                  --
 
4
--  This software  is (c) The European Organisation  for the Safety --
 
5
--  of Air  Navigation (EUROCONTROL) and Adalog  2004-2005. The Ada --
 
6
--  Controller  is  free software;  you can redistribute  it and/or --
 
7
--  modify  it under  terms of  the GNU  General Public  License as --
 
8
--  published by the Free Software Foundation; either version 2, or --
 
9
--  (at your  option) any later version.  This  unit is distributed --
 
10
--  in the hope  that it will be useful,  but WITHOUT ANY WARRANTY; --
 
11
--  without even the implied warranty of MERCHANTABILITY or FITNESS --
 
12
--  FOR A  PARTICULAR PURPOSE.  See the GNU  General Public License --
 
13
--  for more details.   You should have received a  copy of the GNU --
 
14
--  General Public License distributed  with this program; see file --
 
15
--  COPYING.   If not, write  to the  Free Software  Foundation, 59 --
 
16
--  Temple Place - Suite 330, Boston, MA 02111-1307, USA.           --
 
17
--                                                                  --
 
18
--  As  a special  exception, if  other files  instantiate generics --
 
19
--  from the units  of this program, or if you  link this unit with --
 
20
--  other files  to produce  an executable, this  unit does  not by --
 
21
--  itself cause the resulting executable  to be covered by the GNU --
 
22
--  General  Public  License.   This  exception  does  not  however --
 
23
--  invalidate any  other reasons why the executable  file might be --
 
24
--  covered by the GNU Public License.                              --
 
25
--                                                                  --
 
26
--  This  software is  distributed  in  the hope  that  it will  be --
 
27
--  useful,  but WITHOUT  ANY  WARRANTY; without  even the  implied --
 
28
--  warranty  of  MERCHANTABILITY   or  FITNESS  FOR  A  PARTICULAR --
 
29
--  PURPOSE.                                                        --
 
30
----------------------------------------------------------------------
 
31
 
1
32
-- Ada
2
33
with
3
34
  Ada.Characters.Handling,
4
35
  Ada.Strings.Wide_Fixed,
5
36
  Ada.Strings.Wide_Maps,
6
37
  Ada.Strings.Wide_Unbounded,
7
 
  Ada.Wide_Text_Io,
 
38
  Ada.Wide_Text_IO,
8
39
  Ada.Exceptions;
9
40
 
10
41
-- Adalog
15
46
 
16
47
-- Adactl
17
48
with
18
 
  Framework.Reports,
19
 
  Framework.Rules_Manager;
 
49
  Framework.Reports;
20
50
 
21
51
package body Adactl_Options is
22
52
 
23
 
   Version : constant Wide_String := "1.4r20";
24
 
 
25
53
   package Analyzer is
26
 
      new Options_Analyzer (Binary_Options => "DdehiIrsuvwx",
27
 
                            Valued_Options => "flop",
 
54
      new Options_Analyzer (Binary_Options => "CDdeEhiIrsuvwx",
 
55
                            Valued_Options => "fFlopSt",
28
56
                            Tail_Separator => "--");
29
57
 
30
58
   Unit_List    : Ada.Strings.Wide_Unbounded.Unbounded_Wide_String;
51
79
 
52
80
   pragma No_Return (Option_Error);
53
81
 
54
 
   ----------
55
 
   -- Help --
56
 
   ----------
 
82
   ------------------
 
83
   -- Help_Options --
 
84
   ------------------
57
85
 
58
 
   procedure Help is
59
 
      use Utilities, Framework.Rules_Manager;
 
86
   procedure Help_Options is
 
87
      use Utilities, Framework.Reports;
60
88
   begin
61
89
      User_Message ("Usage: adactl [-deirsuvw] [-f <rules file>] [-l <rules list>] [-o <output file>]");
62
90
      User_Message ("          [-p <project file>] <unit>[+|-<unit>]|[@]<file> ... [-- <ASIS options>]");
63
91
      User_Message ("       adactl -h [<rule id>... | all]");
64
 
      User_Message ("       adactl -I [-deirsuvw] [-o <output file>]");
 
92
      User_Message ("       adactl -I [-deirsuvw] [-f <rules file>] [-l <rules list>] [-o <output file>]");
65
93
      User_Message ("          [-p <project file>] <unit>[+|-<unit>]|[@]<file> ... [-- <ASIS options>]");
66
94
      User_Message ("       adactl -D [-rsw] [-o <output file>]");
67
95
      User_Message ("          [-p <project file>] <unit>[+|-<unit>]|[@]<file> ... [-- <ASIS options>]");
 
96
      User_Message ("       adactl -C [-dv] [-f <rules file>] [-l <rules list>]");
68
97
      User_Message ("");
69
98
 
 
99
      User_Message ("Special modes:");
 
100
      User_Message ("   -h        prints this help message");
 
101
      User_Message ("   -h rule   prints rule help");
 
102
      User_Message ("   -h all    prints all rules help");
 
103
      User_Message ("   -I        interactive mode");
 
104
      User_Message ("   -D        generate dependencies");
 
105
      User_Message ("   -C        check rules syntax only");
70
106
      User_Message ("Options:");
71
 
      User_Message ("   -d       enable debug mode");
72
 
      User_Message ("   -e       treat warnnings (Search) as errors (Check)");
73
 
      User_Message ("   -f file  use a file for the specification of rules");
74
 
      User_Message ("   -h       prints this help message");
75
 
      User_Message ("   -h rule  prints rule help");
76
 
      User_Message ("   -h all   prints all rules help");
77
 
      User_Message ("   -i       ignore local deactivations");
78
 
      User_Message ("   -l rules process with this rules");
79
 
      User_Message ("   -o file  specify an output file");
80
 
      User_Message ("   -p file  specify an emacs ada-mode project file (.adp)");
81
 
      User_Message ("   -r       recursive");
82
 
      User_Message ("   -s       process specifications only");
83
 
      User_Message ("   -u       treat all parameters as Ada units");
84
 
      User_Message ("   -v       enable verbose mode");
85
 
      User_Message ("   -w       overwrite output file (works with -o)");
86
 
      User_Message ("   -x       exit when internal error");
87
 
      User_Message ("Rules:");
88
 
      Help_Names;
89
 
      User_Message ("");
90
 
      User_Message ("ADACTL v. " & Version);
91
 
      User_Message ("Copyright (C) 2004-2005 Eurocontrol/Adalog.");
92
 
      User_Message ("This software is covered by the GNU Modified General Public License.");
93
 
   end Help;
 
107
      User_Message ("   -d        enable debug mode");
 
108
      User_Message ("   -e        treat warnings (Search) as errors (Check)");
 
109
      User_Message ("   -E        print only errors (Check)");
 
110
      User_Message ("   -f file   use a file for the specification of rules");
 
111
      User_Message ("   -F format choose output format (GNAT, GNAT_SHORT, CSV, CSV_SHORT, CSVX, CSVX_SHORT)");
 
112
      User_Message ("   -i        ignore local deactivations");
 
113
      User_Message ("   -l rules  process with these rules");
 
114
      User_Message ("   -o file   specify an output file");
 
115
      User_Message ("   -p file   specify an emacs ada-mode project file (.adp)");
 
116
      User_Message ("   -r        recursive");
 
117
      User_Message ("   -s        process specifications only");
 
118
      User_Message ("   -S        statistics level (0 .."
 
119
                      & Integer'Wide_Image (Stats_Levels'Pos (Stats_Levels'Last))
 
120
                      & ')');
 
121
      User_Message ("   -t file   specify a trace file");
 
122
      User_Message ("   -u        treat all parameters as Ada units");
 
123
      User_Message ("   -v        enable verbose mode");
 
124
      User_Message ("   -w        overwrite output file (works with -o)");
 
125
      User_Message ("   -x        exit when internal error");
 
126
   end Help_Options;
94
127
 
95
128
   --------------------
96
129
   -- Gnat_Unit_Name --
97
130
   --------------------
98
131
 
99
132
   function Gnat_Unit_Name (S : in Wide_String) return Wide_String is
100
 
      use Ada.Characters.Handling;
101
133
      use Ada.Strings;
102
134
      use Ada.Strings.Wide_Maps;
103
135
      use Ada.Strings.Wide_Fixed;
129
161
   --------------
130
162
 
131
163
   procedure Add_Unit (S : in Wide_String) is
132
 
      use Utilities, Ada.Strings.Wide_Fixed, Ada.Strings.Wide_Unbounded;
 
164
      use Utilities, Ada.Strings, Ada.Strings.Wide_Fixed, Ada.Strings.Wide_Unbounded;
133
165
 
134
166
      Ext  : constant Wide_String := To_Upper (Tail (S, 4));
 
167
 
 
168
      procedure Add_Parents (Unit : Wide_String) is
 
169
         -- Add parents of the given unit *before* the unit, in order to make sure
 
170
         -- that a parent unit is always processed before its children.
 
171
         Point_Pos : constant Natural := Index (Unit, ".", Going => Backward);
 
172
      begin
 
173
         if Point_Pos = 0 then
 
174
            return;
 
175
         end if;
 
176
 
 
177
         if Point_Pos = Unit'First then
 
178
            -- Name starts with '.'
 
179
            -- Can happen if the user gives "../name" instead of "../name.adb"
 
180
            Option_Error ("Illegal syntax for a unit (not file) name");
 
181
         end if;
 
182
 
 
183
         Add_Parents (Unit (Unit'First .. Point_Pos - 1));
 
184
         Append (Unit_List, "+" & Unit (Unit'First .. Point_Pos - 1));
 
185
      end Add_Parents;
135
186
   begin
 
187
      if S(S'First) = '@' then
 
188
         Body_Found := True;
 
189
         Append (Unit_List, S);
 
190
         return;
 
191
      end if;
 
192
 
136
193
      if not Unit_Option and (Ext = ".ADS" or Ext = ".ADB") then
137
194
         -- Take it as a file name
138
195
         if Ext = ".ADB" then
139
196
            Body_Found := True;
140
197
         end if;
141
 
 
142
 
         if Unit_List = Null_Unbounded_Wide_String then
143
 
            Unit_List :=  To_Unbounded_Wide_String (Gnat_Unit_Name (S));
144
 
         else
145
 
            Append (Unit_List, "+" & Gnat_Unit_Name (S));
146
 
         end if;
 
198
         declare
 
199
            Unit : constant Wide_String := Gnat_Unit_Name (S);
 
200
         begin
 
201
            Add_Parents (Unit);
 
202
            Append (Unit_List, "+" & Unit);
 
203
         end;
147
204
 
148
205
      else
149
206
         -- Unit name(s)
150
207
         Body_Found := True;
151
 
         if Unit_List = Null_Unbounded_Wide_String then
152
 
            Unit_List :=  To_Unbounded_Wide_String (S);
153
 
         elsif S(1) = '+' or S(1) = '-' then
154
 
            Append (Unit_List, S);
155
 
         else
156
 
            Append (Unit_List, "+" & S);
157
 
         end if;
 
208
         case S(S'First) is
 
209
            when '+' =>
 
210
               Add_Parents (S (S'First+1..S'Last));
 
211
               Append (Unit_List, S);
 
212
            when '-' =>
 
213
               Append (Unit_List, S);
 
214
            when others =>
 
215
               Add_Parents (S);
 
216
               Append (Unit_List, "+" & S);
 
217
         end case;
158
218
      end if;
159
219
   end Add_Unit;
160
220
 
163
223
   ---------------------
164
224
 
165
225
   procedure Analyse_Options is
166
 
      use Ada.Wide_Text_Io, Ada.Characters.Handling, Ada.Strings.Wide_Fixed,
167
 
        Ada.Strings, Ada.Strings.Wide_Unbounded;
168
 
      use Utilities, Analyzer, Framework.Rules_Manager;
 
226
      use Ada.Characters.Handling, Ada.Strings, Ada.Strings.Wide_Fixed, Ada.Strings.Wide_Unbounded;
 
227
      use Utilities, Analyzer;
169
228
   begin
170
229
      --
171
230
      -- Help
172
231
      --
173
232
      if Is_Present (Option => 'h') then
174
 
         Action := Help;
175
233
 
176
234
         if Parameter_Count = 0 then
177
 
            Help;
 
235
            Action := Help;
178
236
         else
179
 
            for I in 1.. Parameter_Count loop
180
 
               declare
181
 
                  Val : constant Wide_String := To_Wide_String (Parameter (I));
182
 
               begin
183
 
                  if To_Upper (Val) = "ALL" then
184
 
                     Framework.Rules_Manager.Help_All;
185
 
                  else
186
 
                     Framework.Rules_Manager.Help (Val);
187
 
                  end if;
188
 
               end;
 
237
            Action := Help_Rule;
 
238
            for I in Natural range 1.. Parameter_Count loop
 
239
               Options_Commands := Options_Commands & "help " & To_Wide_String (Parameter (I)) & ';';
189
240
            end loop;
190
241
         end if;
191
242
 
192
243
         return;
193
244
 
 
245
      elsif Is_Present (Option => 'C') then  -- Must be first for -C to override any other option (except help)
 
246
         Action := Check;
 
247
 
194
248
      elsif Is_Present (Option => 'D') then
195
249
         Action := Dependents;
196
250
 
211
265
      Utilities.Verbose_Option := Is_Present (Option => 'v');
212
266
      Overwrite_Option         := Is_Present (Option => 'w');
213
267
 
 
268
      if Is_Present (Option => 'S') then
 
269
         declare
 
270
            Temp_Value : Integer;
 
271
            use Framework.Reports;
 
272
         begin
 
273
            Temp_Value := Value ('S',
 
274
                                 Default => Stats_Levels'Pos (Stats_Levels'Last),
 
275
                                 Explicit_Required => False);
 
276
            if Temp_Value not in 0 .. Stats_Levels'Pos (Stats_Levels'Last) then
 
277
               Option_Error ("Value for S option must be in range 0 .."
 
278
                               & Integer'Image (Stats_Levels'Pos (Stats_Levels'Last)));
 
279
            end if;
 
280
            Options_Commands := Options_Commands
 
281
              & "set statistics" & Integer'Wide_Image (Temp_Value) & ';';
 
282
         end;
 
283
      end if;
 
284
 
214
285
      if Is_Present (Option => 'o') then
215
286
         -- modify current output
216
287
         Options_Commands := Options_Commands
217
288
           & "set output " & To_Wide_String (Value (Option => 'o', Explicit_Required => True)) & ';';
218
289
      end if;
219
290
 
 
291
      if Is_Present (Option => 't') then
 
292
         -- modify current trace
 
293
         Options_Commands := Options_Commands
 
294
           & "set trace " & To_Wide_String (Value (Option => 't', Explicit_Required => True)) & ';';
 
295
      end if;
 
296
 
220
297
      Framework.Reports.Warning_As_Error_Option := Is_Present (Option => 'e');
 
298
      Framework.Reports.Skip_Warning_Option     := Is_Present (Option => 'E');
221
299
 
222
300
      -- Process options
223
301
      Recursive_Option := Is_Present (Option => 'r');
226
304
      Spec_Option      := Is_Present (Option => 's');
227
305
      Exit_Option      := Is_Present (Option => 'x');
228
306
 
229
 
      if Parameter_Count = 0 then
 
307
      if Action /= Check and Parameter_Count = 0 then
230
308
         Option_Error ("At least one unit/file required");
231
309
      end if;
232
310
 
233
 
      if Is_Present (Option => 'D') then
 
311
      if Action = Dependents then
234
312
         if Is_Present (Option => 'l') or Is_Present (Option => 'f') then
235
313
            Option_Error ("No rule can be specified with -D option");
236
314
         elsif Is_Present (Option => 'I') then
237
315
            Option_Error ("-D and -I options cannot be specified together");
238
316
         end if;
239
 
      elsif    not Is_Present (Option => 'l')
 
317
      elsif Action /= Interactive_Process
 
318
        and not Is_Present (Option => 'l')
240
319
        and not Is_Present (Option => 'f')
241
 
        and not Is_Present (Option => 'I')
242
320
      then
243
321
         Option_Error("No rules specified");
244
322
      end if;
245
323
 
 
324
      if Is_Present (Option => 'F') then
 
325
         -- Output format
 
326
         Options_Commands := Options_Commands
 
327
           & "set format " & To_Wide_String (Value (Option => 'F', Explicit_Required => True)) & ';';
 
328
      end if;
 
329
 
246
330
      if Is_Present (Option => 'l') then
247
331
         -- add rules uses from command line
248
332
         Options_Commands := Options_Commands
260
344
           & "source " & To_Wide_String (Value (Option => 'f', Explicit_Required => True)) & ';';
261
345
      end if;
262
346
 
263
 
      for I in 1 .. Parameter_Count loop
264
 
         Add_Unit (To_Wide_String (Parameter (I)));
265
 
      end loop;
266
 
      Spec_Option := Spec_Option or not Body_Found;
 
347
      if Action /= Check then
 
348
         for I in Natural range 1 .. Parameter_Count loop
 
349
            Add_Unit (To_Wide_String (Parameter (I)));
 
350
         end loop;
 
351
         Spec_Option := Spec_Option or not Body_Found;
 
352
      end if;
267
353
 
268
354
   exception
269
355
      when Occur : Analyzer.Options_Error =>
270
356
         Option_Error (Occur);
271
357
      when Overwrite_Error =>
272
 
         Option_Error ("File " & Value (Option => 'o')
273
 
                       & " already exists, use ""-w"" to overwrite");
274
 
 
 
358
         Option_Error ("File " & Value (Option => 'o') & " already exists, use ""-w"" to overwrite");
275
359
   end Analyse_Options;
276
360
 
277
361
   ------------------
311
395
 
312
396
   function Initialize_String return Wide_String is
313
397
   begin
314
 
      return Implementation_Options.Initialize_String;
 
398
      return Implementation_Options.Initialize_String (Utilities.Debug_Option);
315
399
   end Initialize_String;
316
400
 
317
401
   ---------------------------