semantic_versioning_2.1.0_cc692011/src/semantic_versioning-basic.adb

  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
with Ada.Characters.Handling;
with Ada.Exceptions;
with Ada.Strings.Fixed;

with GNAT.Case_Util;

package body Semantic_Versioning.Basic is

   Separator : constant Character := '&';

   -------------------
   -- To_Mixed_Case --
   -------------------

   function To_Mixed_Case (S : String) return String is
   begin
      return SMC : String := S do
         GNAT.Case_Util.To_Mixed (SMC);
      end return;
   end To_Mixed_Case;

   -----------------------
   -- Image_Abbreviated --
   -----------------------

   function Image_Abbreviated (VS             : Version_Set;
                               Unicode        : Boolean := False;
                               Implicit_Equal : Boolean := False) return String
   is

      function Inner_Image (VS : Version_Set) return String is
         Cond   : constant Restriction := VS.First_Element;
         Remain : Version_Set := VS;
      begin
         Remain.Delete_First;

         return Operator_Image (Cond, Unicode, Implicit_Equal) &
         (if VS.Length > Natural'(1)
          then " " & Separator & " " & Inner_Image (Remain)
          else "");
      end Inner_Image;

   begin
      if VS.Is_Empty then
         return "*";
      else
         return Inner_Image (VS);
      end if;
   end Image_Abbreviated;

   ---------------
   -- Image_Ada --
   ---------------

   function Image_Ada (VS : Version_Set) return String is

      function Inner_Image (VS : Version_Set) return String is
         Cond   : constant Restriction := VS.First_Element;
         Remain : Version_Set := VS;
      begin
         Remain.Delete_First;

         return To_Mixed_Case (Cond.Condition'Img) & " (" & Image (Cond.On_Version) & ")" &
           (if VS.Length > Natural'(1) then " and " & Inner_Image (Remain) else "");
      end Inner_Image;

   begin
      if VS.Is_Empty then
         return "Any";
      else
         return Inner_Image (VS);
      end if;
   end Image_Ada;

   -----------
   -- Is_In --
   -----------

   function Is_In (V : Version; VS : Version_Set) return Boolean is
   begin
      for R of VS loop
         if not Satisfies (V, R) then
            return False;
         end if;
      end loop;

      return True;
   end Is_In;

   -----------
   -- Parse --
   -----------

   function Parse (S       : String;
                   Relaxed : Boolean := False;
                   Unicode : Boolean := True) return Result
   is
      use Ada.Strings;
      use Ada.Strings.Fixed;

      Err_Empty : constant String := "Expression is empty";

      Prev : Integer := S'First;
      Next : Integer := Prev + 1;
      Set  : Version_Set;
   begin
      --  Check for emptiness first:
      if Trim (S, Side => Both) = "" then
         return Result'(Valid  => False,
                        Length => Err_Empty'Length,
                        Error  => Err_Empty);
      end if;

      loop
         while Next <= S'Last and then S (Next) /= Separator loop
            Next := Next + 1;
         end loop;

         exit when Prev > S'Last;

         declare
            Single_Set : constant Version_Set :=
                           To_Set (Trim (S (Prev .. Next - 1), Side => Both),
                                   Relaxed => Relaxed,
                                   Unicode => Unicode);
         begin
            Prev := Next + 1;
            Next := Prev + 1;
            Set := Set and Single_Set;
         end;
      end loop;

      return Result'(Valid  => True,
                     Length => 0,
                     Set    => Set);
   exception
      when E : others =>
         declare
            Error : constant String := Ada.Exceptions.Exception_Message (E);
         begin
            return Result'(Valid  => False,
                           Length => Error'Length,
                           Error  => Error);
         end;
   end Parse;

   ---------------
   -- Satisfies --
   ---------------

   function Satisfies (V : Version; R : Restriction) return Boolean is
   begin
      case R.Condition is
         when At_Least =>
            return V = R.On_Version or else R.On_Version < V;
         when At_Most =>
            return V < R.On_Version or else V = R.On_Version;
         when Exactly =>
            return V = R.On_Version;
         when Except =>
            return V /= R.On_Version;
         when Within_Major =>
            return (R.On_Version < V or else R.On_Version = V) and then R.On_Version.Major = V.Major;
         when Within_Minor =>
            return (R.On_Version < V or else R.On_Version = V) and Then
                    R.On_Version.Major = V.Major and then R.On_Version.Minor = V.Minor;
      end case;
   end Satisfies;

   ------------
   -- To_Set --
   ------------

   function To_Set (S       : Version_String;
                    Relaxed : Boolean := False;
                    Unicode : Boolean := True) return Version_Set is
      subtype Numbers is Character range '0' .. '9';

      --  Convenience to remove the operator, whatever its length
      function Remainder (S : String; Pattern : String) return String is
         (S (S'First + Pattern'Length .. S'Last));

      package ACH renames Ada.Characters.Handling;
   begin
      --  Special cases first
      if ACH.To_Lower (S) = "any" or else S = "*" then
         return Any;
      elsif S = "" then
         raise Malformed_Input with "empty string";
      elsif S (S'First) in Numbers then
         return Exactly (Parse (S, Relaxed));
      end if;

      --  Simple cases
      declare
         Op      : constant Character := S (S'First);
         Version : constant String    := S (S'First + 1 .. S'Last);
      begin
         case Op is
            when '=' => return Exactly (Parse (Version, Relaxed));
            when '^' => return Within_Major (Parse (Version, Relaxed));
            when '~' => return Within_Minor (Parse (Version, Relaxed));
            when others => null; -- Check next cases
         end case;
      end;

      --  Rest of cases
      if Begins_With (S, "/=") then
         return Except (Parse (Remainder (S, "/="), Relaxed));
      elsif Unicode and then Begins_With (S, "≠") then
         return Except (Parse (Remainder (S, "≠"), Relaxed));
      elsif Begins_With (S, ">=") then
         return At_Least (Parse (Remainder (S, ">="), Relaxed));
      elsif Unicode and then Begins_With (S, "≥") then
         return At_Least (Parse (Remainder (S, "≥"), Relaxed));
      elsif Begins_With (S, "<=") then
         return At_most (Parse (Remainder (S, "<="), Relaxed));
      elsif Unicode and then Begins_With (S, "≤") then
         return At_Most (Parse (Remainder (S, "≤"), Relaxed));
      elsif Begins_With (S, ">") then
         return More_Than (Parse (Remainder (S, ">"), Relaxed));
      elsif Begins_With (S, "<") then
         return Less_Than (Parse (Remainder (S, "<"), Relaxed));
      end if;

      --  All others
      raise Malformed_Input with "invalid set: " & S;
   end To_Set;

   -----------
   -- Value --
   -----------

   function Value (S       : String;
                   Relaxed : Boolean := False;
                   Unicode : Boolean := True) return Version_Set
   is
      R : constant Result := Parse (S,
                                    Relaxed => Relaxed,
                                    Unicode => Unicode);
   begin
      if R.Valid then
         return R.Set;
      else
         raise Malformed_Input with R.Error;
      end if;
   end Value;
end Semantic_Versioning.Basic;