Natools

Check-in [60174b5c09]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:getopt_long: move Posixly_Correct and Long_Only into Configuration objects
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 60174b5c094d6d01988bed349cad123b4cc5450b
User & Date: nat on 2011-12-09 16:10:43
Other Links: manifest | tags
Context
2011-12-09
22:56
Separation of library source and test code into distinct directories check-in: fb1e9e5c96 user: nat tags: trunk
16:10
getopt_long: move Posixly_Correct and Long_Only into Configuration objects check-in: 60174b5c09 user: nat tags: trunk
12:50
getopt_long: rename Option_Definitions type to Configuration check-in: 5564c1c256 user: nat tags: trunk
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified natools-getopt_long.adb from [7692854d6a] to [d133c1264a].

︙
98
99
100
101
102
103
104

































105
106
107
108
109
110
111

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








+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+








      begin
         raise Option_Error with "Unknown option " & Image (Name);
      end Unknown_Option;

   end Handlers;



   -------------------------------------
   -- Simple configuration parameters --
   -------------------------------------

   function Posixly_Correct (Config : Configuration) return Boolean is
   begin
      return Config.Posixly_Correct;
   end Posixly_Correct;


   procedure Posixly_Correct
     (Config : in out Configuration;
      To     : Boolean := True) is
   begin
      Config.Posixly_Correct := To;
   end Posixly_Correct;


   function Long_Only (Config : Configuration) return Boolean is
   begin
      return Config.Long_Only;
   end Long_Only;


   procedure Use_Long_Only
     (Config : in out Configuration;
      Value  : Boolean := True) is
   begin
      Config.Long_Only := Value;
   end Use_Long_Only;



   ----------------------------
   -- Option list management --
   ----------------------------

   procedure Add_Option
     (Config     : in out Configuration;
︙
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486

504
505
506
507
508
509
510


511
512
513
514
515
516
517








-
-








   -----------------------------
   -- Command-line processing --
   -----------------------------

   procedure Process
     (Config : Configuration;
      Handler : in out Handlers.Callback'Class;
      Posixly_Correct : Boolean := True;
      Long_Only : Boolean := False;
      Argument_Count : not null access function return Natural
        := Ada.Command_Line.Argument_Count'Access;
      Argument : not null access function (Number : Positive) return String
        := Ada.Command_Line.Argument'Access)
   is
      procedure Process_Long_Option (Arg : String);
︙
563
564
565
566
567
568
569
570

571
572
573
574
575
576
577
578
579
580
581
582
583
584
585

586
587
588
589
590
591
592

594
595
596
597
598
599
600

601
602
603
604
605
606
607
608
609
610
611
612
613
614
615

616
617
618
619
620
621
622
623








-
+














-
+








      while Arg_N <= Arg_Count loop
         declare
            Arg : constant String := Argument (Arg_N);
         begin
            if Arg'Length <= 1 or else Arg (Arg'First) /= '-' then
               --  This is a non-flag argument, abort option processing if
               --    posixly correct.
               if Posixly_Correct then
               if Config.Posixly_Correct then
                  exit;
               else
                  Handler.Argument (Arg);
                  Arg_N := Arg_N + 1;
               end if;
            elsif Arg (Arg'First + 1) = '-' then
               --  "--" stops option processing.
               if Arg'Length = 2 then
                  Arg_N := Arg_N + 1;
                  exit;
               end if;
               --  Argument starting with "--": long option.
               Process_Long_Option (Arg (Arg'First + 2 .. Arg'Last));
               Arg_N := Arg_N + 1;
            elsif Long_Only then
            elsif Config.Long_Only then
               --  Force long option on a single dash prefix.
               Process_Long_Option (Arg (Arg'First + 1 .. Arg'Last));
               Arg_N := Arg_N + 1;
            else
               --  Process a list of short options, until one with required
               --    argument is encountered (and the rest is its argument).
               for Arg_I in Arg'First + 1 .. Arg'Last loop
︙

Modified natools-getopt_long.ads from [21b9a936b8] to [1cc6b942cb].

︙
124
125
126
127
128
129
130


















131
132
133
134
135
136
137

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








+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+








   ----------------------------

   type Argument_Requirement is
     (No_Argument, Required_Argument, Optional_Argument);

   type Configuration is tagged private;


   -- Simple parameters --

   function Posixly_Correct (Config : Configuration) return Boolean;

   procedure Posixly_Correct
     (Config : in out Configuration;
      To     : Boolean := True);

   function Long_Only (Config : Configuration) return Boolean;

   procedure Use_Long_Only
     (Config : in out Configuration;
      Value  : Boolean := True);


   -- Option list management --

   procedure Add_Option
     (Config     : in out Configuration;
      Long_Name  : String;
      Short_Name : Character;
      Has_Arg    : Argument_Requirement;
      Id         : Option_Id);
      --  Add an option with both a short and a long name to the database.
︙
161
162
163
164
165
166
167



168
169
170
171
172
173
174

179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195








+
+
+








      --  Remove from the database an option identified by its long name.

   procedure Del_Option
     (Config     : in out Configuration;
      Short_Name : Character);
      --  Remove from the database an option identified by its short name.


   -- Formatting subprograms --

   function Format_Long_Names
     (Config      : Configuration;
      Id          : Option_Id;
      Separator   : String := ", ";
      Name_Prefix : String := "--")
      return String;
      --  Return a human-readable list of long names for the given option.
︙
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252

258
259
260
261
262
263
264


265
266
267
268
269
270
271








-
-








   --------------------------------------
   -- Command line argument processing --
   --------------------------------------

   procedure Process
     (Config : Configuration;
      Handler : in out Handlers.Callback'Class;
      Posixly_Correct : Boolean := True;
      Long_Only : Boolean := False;
      Argument_Count : not null access function return Natural
        := Ada.Command_Line.Argument_Count'Access;
      Argument : not null access function (Number : Positive) return String
        := Ada.Command_Line.Argument'Access);
      --  Process system command line argument list, using the provided option
      --    definitions and handler callbacks.
︙
264
265
266
267
268
269
270


271
272
273

283
284
285
286
287
288
289
290
291
292
293
294








+
+





   package Short_Option_Maps is
      new Ada.Containers.Indefinite_Ordered_Maps (Character, Option);

   type Configuration is tagged record
      By_Long_Name : Long_Option_Maps.Map;
      By_Short_Name : Short_Option_Maps.Map;
      Posixly_Correct : Boolean := True;
      Long_Only : Boolean := False;
   end record;

end Natools.Getopt_Long;

Modified natools-getopt_long_tests.adb from [8533326941] to [71375b159f].

︙
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

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








-
+
+
+



-
+
+
+













+
+









   type Flag_Argument_Array is array (Option_Id) of US.Unbounded_String;

   Separator : constant Character := ';';

   package Getopt is new Natools.Getopt_Long (Option_Id);

   function Getopt_Config return Getopt.Configuration;
   function Getopt_Config
     (Posixly_Correct, Long_Only : Boolean)
      return Getopt.Configuration;
      --  Create the Getopt.Configuration object used for these tests.


   function Getopt_Config return Getopt.Configuration is
   function Getopt_Config
     (Posixly_Correct, Long_Only : Boolean)
      return Getopt.Configuration is
   begin
      return OD : Getopt.Configuration do
         OD.Add_Option ('a', Getopt.No_Argument, Short_No_Arg);
         OD.Add_Option ('q', Getopt.No_Argument, Short_No_Arg_2);
         OD.Add_Option ('f', Getopt.Required_Argument, Short_Arg);
         OD.Add_Option ('v', Getopt.Optional_Argument, Short_Opt_Arg);
         OD.Add_Option ("aq", Getopt.No_Argument, Long_Ambiguous);
         OD.Add_Option ("aquatic", Getopt.No_Argument, Long_No_Arg);
         OD.Add_Option ("color", Getopt.Optional_Argument, Long_Opt_Arg);
         OD.Add_Option ("input", Getopt.Required_Argument, Long_Arg);
         OD.Add_Option ("execute", 'e', Getopt.Required_Argument, Mixed_Arg);
         OD.Add_Option ("ignore-case", 'i', Getopt.No_Argument, Mixed_No_Arg);
         OD.Add_Option ("write", 'w', Getopt.Optional_Argument, Mixed_Opt_Arg);
         OD.Posixly_Correct (Posixly_Correct);
         OD.Use_Long_Only (Long_Only);
      end return;
   end Getopt_Config;



   -------------------
   -- Test Handlers --
︙
284
285
286
287
288
289
290
291


292
293
294
295
296
297
298
299
300
301
302
303
304
305
306

290
291
292
293
294
295
296

297
298
299
300
301
302
303
304


305
306
307
308
309
310
311








-
+
+






-
-








      Expected_Seen : Flag_Seen_Array;
      Expected_Argument : Flag_Argument_Array;
      Expected_Error : String_Vectors.Vector := String_Vectors.Empty_Vector;
      Posixly_Correct : Boolean := True;
      Long_Only : Boolean := False)
   is
      use type String_Vectors.Vector;
      Config : constant Getopt.Configuration := Getopt_Config;
      Config : constant Getopt.Configuration
        := Getopt_Config (Posixly_Correct, Long_Only);
      Handler : Handlers.Basic;
   begin
      begin
         Getopt.Process
           (Config             => Config,
            Handler            => Handler,
            Posixly_Correct    => Posixly_Correct,
            Long_Only          => Long_Only,
            Argument_Count     => Argument_Count'Access,
            Argument           => Argument'Access);
      exception
         when Error : Getopt.Option_Error =>
            Handler.Flag_Error.Append
              (Ada.Exceptions.Exception_Message (Error));
      end;
︙
385
386
387
388
389
390
391
392

393
394
395
396
397
398
399

390
391
392
393
394
395
396

397
398
399
400
401
402
403
404








-
+








      procedure Local_Test
        (Name : String;
         Expected_Seen : Flag_Seen_Array;
         Expected_Argument : Flag_Argument_Array;
         Expected_Count : Handlers.Error_Count)
      is
         use type Handlers.Error_Count;
         Config : constant Getopt.Configuration := Getopt_Config;
         Config : constant Getopt.Configuration := Getopt_Config (True, False);
         Handler : Handlers.Recovering;
      begin
         Getopt.Process
           (Config         => Config,
            Handler        => Handler,
            Argument_Count => Argument_Count'Access,
            Argument       => Argument'Access);
︙

This page was generated in about 0.005s by Fossil 2.23 [47362306a7] 2023-11-01 18:56:47