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 | with Ada.Strings.Maps;
with Semantic_Versioning.Basic;
with Semantic_Versioning.Extended;
package body Semantic_Versioning is
-----------------
-- Begins_With --
-----------------
-- See if a substring is at the beginning of another, subrange-safe
function Begins_With (S : String; Pattern : String) return Boolean is
(if Pattern'Length >= S'Length then False -- We need at least one extra character for the actual version
else S (S'First .. S'First + Pattern'Length - 1) = Pattern);
----------------------------
-- Begins_With_Relational --
----------------------------
function Begins_With_Relational (S : String;
Unicode : Boolean := False) return Boolean is
((S'Length >= 1 and then S (S'First) in '<' | '>' | '=' | '/' | '~' | '^')
or else
(Unicode and then
(Begins_With (S, "≠") or else
Begins_With (S, "≥") or else
Begins_With (S, "≤"))));
-----------
-- Parse --
-----------
function Parse (Description : Version_String;
Relaxed : Boolean := False) return Version
is
Next : Positive := Description'First;
V : Version;
type Tokens is (Number, Dot, Minus, Plus, Other, Done);
type Foreseeable is (Major, Minor, Patch, Nothing);
To_See : Foreseeable := Major;
---------------
-- Next_Char --
---------------
function Next_Char return Character is
(Description (Next));
----------------
-- Next_Token --
----------------
function Next_Token (At_Position : Natural := Next) return Tokens is
(if At_Position > Description'Last
then Done
else
(case Description (At_Position) is
when '.' => Dot,
when '+' => Plus,
when '-' => Minus,
when '0' .. '9' => Number,
when others => Other));
----------------
-- Eat_Number --
----------------
function Eat_Number return Point is
Last : Natural := Next + 1;
begin
while Last <= Description'Last and then Next_Token (Last) = Number loop
Last := Last + 1;
end loop;
if Next > Description'Last or else Last = Next then
raise Malformed_Input with "Empty point number";
end if;
return Number : constant Point := Point'Value (Description (Next .. Last - 1)) do
Next := Last;
end return;
end Eat_Number;
--------------
-- Eat_Char --
--------------
procedure Eat_Char is
begin
Next := Next + 1;
end Eat_Char;
------------------
-- Accept_Build --
------------------
procedure Accept_Build is
begin
V.Build := Ustrings.To_Unbounded_String (Description (Next .. Description'Last));
Next := Description'Last + 1;
end Accept_Build;
----------------
-- Accept_Pre --
----------------
procedure Accept_Pre is
Last : Natural := Next + 1;
begin
if Next > Description'Last then
raise Malformed_Input with "Empty pre-release part: " & Description;
end if;
while Last <= Description'Last and then Description (Last) /= '+' loop
Last := Last + 1;
end loop;
V.Pre_Release := UStrings.To_Unbounded_String (Description (Next .. Last - 1));
Next := Last;
case Next_Token is
when Done => null;
when Plus =>
Eat_Char;
Accept_Build;
when others =>
raise Program_Error with "Unexpected token after pre-release: " & Description;
end case;
end Accept_Pre;
-------------------
-- Accept_Number --
-------------------
procedure Accept_Number is
begin
case To_See is
when Major => V.Major := Eat_Number;
when Minor => V.Minor := Eat_Number;
when Patch => V.Patch := Eat_Number;
when others => raise Malformed_Input with "All foreseeable points already seen";
end case;
To_See := Foreseeable'Succ (To_See);
case Next_Token is
when Number => raise Program_Error with "Number found after eating number";
when Dot =>
if To_See = Nothing then
if Relaxed then
Eat_Char;
Accept_Build;
else
raise Malformed_Input with "Too many points in version: " & Description;
end if;
else
Eat_Char;
Accept_Number;
end if;
when Minus =>
Eat_Char;
Accept_Pre;
when Plus =>
Eat_Char;
Accept_Build;
when Other =>
if Relaxed Then
Accept_Build;
else
raise Malformed_Input with "Invalid separator after major number: " & Next_Char;
end if;
when Done => null;
end case;
end Accept_Number;
begin
case Next_Token is
when Number => Accept_Number;
when others => raise Malformed_Input with "Major number expected";
end case;
return V;
end Parse;
---------------------------
-- Less_Than_Pre_Release --
---------------------------
function Less_Than_Pre_Release (L, R : String) return Boolean is
use Ada.Strings;
use Ada.Strings.Fixed;
use Ada.Strings.Maps;
Dot : constant Character_Set := To_Set (".");
L_First, L_Last : Natural := L'First - 1;
R_First, R_Last : Natural := R'First - 1;
L_Num, R_Num : Integer;
begin
-- Special case if one of them is not really a pre-release:
if L /= "" and then R = "" then
return True;
elsif L = "" and then R /= "" then
return False;
end if;
loop
if R_Last = R'Last then -- R depleted, at most L is depleted too
return False;
elsif L_Last = L'Last then -- L depleted, hence is <
return True;
else
null; -- There are more tokens to compare
end if;
Find_Token (L, Dot, L_Last + 1, Outside, L_First, L_Last);
Find_Token (R, Dot, R_Last + 1, Outside, R_First, R_Last);
if R_Last = 0 then
return False; -- L can't be less; at most equal (both empty)
elsif L_Last = 0 then
return True; -- Since R is not exhausted but L is.
else -- Field against field
-- Compare field numerically, if possible:
declare
L_Str : String renames L (L_First .. L_Last);
R_Str : String renames R (R_First .. R_Last);
begin
L_Num := Integer'Value (L_Str);
R_Num := Integer'Value (R_str);
if L_Num /= R_Num then
return L_Num < R_Num;
else
null; -- Try next fields
end if;
exception
when Constraint_Error => -- Can't convert, compare lexicographically
if L_Str /= R_Str then
return L_Str < R_Str;
else
null; -- Try next fields
end if;
end;
end if;
end loop;
end Less_Than_Pre_Release;
---------
-- "<" --
---------
function "<" (L, R : Version) return Boolean is
use UStrings;
begin
if L.Major < R.Major then
return True;
elsif L.Major = R.Major then
if L.Minor < R.Minor then
return True;
elsif L.Minor = R.Minor then
if L.Patch < R.Patch then
return True;
elsif L.Patch = R.Patch then -- Pre-release versions are earlier than regular versions
return Less_Than_Pre_Release (To_String (L.Pre_Release), To_String (R.Pre_Release));
end if;
end if;
end if;
return False; -- In all other cases
end "<";
--------------
-- To_Basic --
--------------
function To_Basic (V : Version) return Basic.Version_Set is
(Basic.Exactly (V));
-----------------
-- To_Extended --
-----------------
function To_Extended (V : Version) return Extended.Version_Set is
(Extended.To_Extended (To_Basic (V)));
-----------------
-- To_Extended --
-----------------
function To_Extended (VS : Basic.Version_Set) return Extended.Version_Set is
(Extended.To_Extended (VS));
---------------
-- Updatable --
---------------
function Updatable (V : Version) return Extended.Version_Set is
(if Major (V) = 0
then To_Extended (Basic.Within_Minor (V))
else To_Extended (Basic.Within_Major (V)));
end Semantic_Versioning;
|