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 | --
with Tokenize;
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
with Ada.Strings.Maps; use Ada.Strings;
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Command_Line; use Ada;
procedure Test_Tokenizer is
Bad_Command_Line : exception;
package CL is
function N_Arguments return Natural;
function First (Default : String) return String;
function First return String
with
Pre => N_Arguments > 0;
pragma Warnings (Off, "postcondition does not mention function result");
function Shift return String
with
Pre => N_Arguments > 0,
Post => N_Arguments = N_Arguments'Old - 1;
procedure Shift
with
Pre => N_Arguments > 0,
Post => N_Arguments = N_Arguments'Old - 1;
pragma Warnings (On, "postcondition does not mention function result");
end CL;
package body Cl is
First_Unread : Positive := 1;
function N_Arguments return Natural
is (Command_Line.Argument_Count - First_Unread + 1);
function First return String
is (Command_Line.Argument (First_Unread));
function First (Default : String) return String
is (if N_Arguments = 0 then
Default
else
First);
function Shift return String
is
begin
return Result : constant String := First do
Shift;
end return;
end Shift;
procedure Shift is
begin
First_Unread := First_Unread + 1;
end Shift;
end Cl;
procedure Print_Help
is
begin
New_Line;
Put_Line ("Usage:");
Put_Line (" test_tokenizer [-q] collate_option string [string...]");
New_Line;
Put_Line ("collate_option has one or more of the following letters:");
New_Line;
Put_Line (" N (none)");
Put_Line (" H (head)");
Put_Line (" T (tail)");
Put_Line (" M (middle)");
Put_Line (" F (full)");
New_Line;
Put_Line ("collate_option is case insensitive");
Put_Line ("option -q makes the output terse");
New_Line;
end Print_Help;
procedure Print (X : Tokenize.Token_Array) is
begin
for I in X'Range loop
Put ("[" & To_String (X(I)) & "]");
if I < X'Last then
Put (" ");
end if;
end loop;
end Print;
function Parse (S : String) return Tokenize.Collation_Option
is
use Tokenize;
Result : Collation_Option := None;
begin
for K in S'Range loop
case S (K) is
when 'n' | 'N' =>
null;
when 'h' | 'H' =>
Result := Result and Tokenize.Head;
when 't' | 'T' =>
Result := Result and Tokenize.Tail;
when 'm' | 'M' =>
Result := Result and Middle;
when 'f' | 'F' =>
Result := Full;
when others =>
raise Bad_Command_Line;
end case;
end loop;
return Result;
end Parse;
Verbose : Boolean := True;
begin
if Cl.First (Default => "") = "-q" then
Cl.Shift;
Verbose := False;
end if;
if Cl.N_Arguments < 2 then
raise Bad_Command_Line;
end if;
declare
Opt : constant Tokenize.Collation_Option := Parse (Cl.Shift);
begin
while Cl.N_Arguments > 0 loop
declare
Arg : constant String := Cl.Shift;
begin
if Verbose then
Put_Line ("### PARSING ###" & Arg);
end if;
Print (Tokenize.Split
(To_Be_Splitted => Arg,
Separator => Maps.To_Set (" ,"),
Collation => Opt));
New_Line;
if Verbose then
Print (Tokenize.Split
(To_Be_Splitted => Arg,
Separator => Maps.To_Set (" ,"),
Collate_Separator => True));
New_Line;
Print (Tokenize.Split
(To_Be_Splitted => Arg,
Separator => Maps.To_Set (" ,"),
Collate_Separator => False));
New_Line;
end if;
end;
end loop;
end;
exception
when Bad_Command_Line =>
Print_Help;
Command_Line.Set_Exit_Status (Command_Line.Failure);
end Test_Tokenizer;
|