Natools

Check-in [2b39e14775]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:s_expressions-conditionals-strings-tests: new package providing a fully covering test suite for string conditionals
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 2b39e1477508c33ec803f67beb78816acbe4bd05
User & Date: nat on 2015-04-01 21:16:34
Other Links: manifest | tags
Context
2015-04-02
21:49
s_expressions-conditionals-tests: new package gather all tests on conditionals check-in: 64a3496a28 user: nat tags: trunk
2015-04-01
21:16
s_expressions-conditionals-strings-tests: new package providing a fully covering test suite for string conditionals check-in: 2b39e14775 user: nat tags: trunk
2015-03-31
19:10
s_expressions-conditionals-strings: new package providing evaluation of boolean expressions about strings check-in: 048393b674 user: nat tags: trunk
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Added tests/natools-s_expressions-conditionals-strings-tests.adb version [3102aeb9ac]. 

































































































































































































































































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

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

------------------------------------------------------------------------------
-- Copyright (c) 2015, Natacha Porté                                        --
--                                                                          --
-- Permission to use, copy, modify, and distribute this software for any    --
-- purpose with or without fee is hereby granted, provided that the above   --
-- copyright notice and this permission notice appear in all copies.        --
--                                                                          --
-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES --
-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF         --
-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR  --
-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES   --
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN    --
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  --
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.           --
------------------------------------------------------------------------------

with Natools.S_Expressions.Caches;
with Natools.S_Expressions.Test_Tools;

package body Natools.S_Expressions.Conditionals.Strings.Tests is

   procedure Check
     (Test : in out NT.Test;
      Context : in Strings.Context;
      Expression : in Caches.Reference;
      Image : in String;
      Expected : in Boolean := True);

   procedure Check
     (Test : in out NT.Test;
      Value : in String;
      Expression : in Caches.Reference;
      Image : in String;
      Expected : in Boolean := True);


   ------------------------------
   -- Local Helper Subprograms --
   ------------------------------

   procedure Check
     (Test : in out NT.Test;
      Context : in Strings.Context;
      Expression : in Caches.Reference;
      Image : in String;
      Expected : in Boolean := True)
   is
      function Match_Image return String;

      Cursor : Caches.Cursor := Expression.First;

      function Match_Image return String is
      begin
         if Expected then
            return " does not match ";
         else
            return " does match ";
         end if;
      end Match_Image;
   begin
      if Evaluate (Context, Cursor) /= Expected then
         Test.Fail ('"' & Context.Data.all & '"' & Match_Image & Image);
      end if;
   end Check;


   procedure Check
     (Test : in out NT.Test;
      Value : in String;
      Expression : in Caches.Reference;
      Image : in String;
      Expected : in Boolean := True)
   is
      function Match_Image return String;

      Cursor : Caches.Cursor := Expression.First;

      function Match_Image return String is
      begin
         if Expected then
            return " does not match ";
         else
            return " does match ";
         end if;
      end Match_Image;
   begin
      if Evaluate (Value, Cursor) /= Expected then
         Test.Fail ('"' & Value & '"' & Match_Image & Image);
      end if;
   end Check;



   -------------------------
   -- Complete Test Suite --
   -------------------------

   procedure All_Tests (Report : in out NT.Reporter'Class) is
   begin
      Basic_Usage (Report);
      Fallbacks (Report);
   end All_Tests;



   ----------------------
   -- Individual Tests --
   ----------------------

   procedure Basic_Usage (Report : in out NT.Reporter'Class) is
      Test : NT.Test := Report.Item ("Basic usage");
   begin
      declare
         procedure Check (Value : in String; Expected : in Boolean := True);

         Image : constant String := "Expression 1";
         Exp : constant Caches.Reference := Test_Tools.To_S_Expression
           ("(or is-empty (starts-with Hi)"
            & "(and (contains 1:.) (contains-any-of 1:! 1:?))"
            & "(case-insensitive (or (contains aLiCe)"
            & " (case-sensitive (contains Bob))))"
            & "(not is-ascii))");

         procedure Check (Value : in String; Expected : in Boolean := True) is
         begin
            Check (Test, Value, Exp, Image, Expected);
         end Check;
      begin
         Check ("");
         Check ("A", False);
         Check ("Hi, my name is John.");
         Check ("Hello, my name is John.", False);
         Check ("Hello. My name is John!");
         Check ("Hello. My name is John?");
         Check ("Alice and Bob");
         Check ("BOBBY!", False);
         Check ("AlicE and Malory");
         Check ("©");
      end;
   exception
      when Error : others => Test.Report_Exception (Error);
   end Basic_Usage;


   procedure Fallbacks (Report : in out NT.Reporter'Class) is
      Test : NT.Test := Report.Item ("Fallback functions");
   begin
      declare
         procedure Check
           (Value : in String;
            With_Fallback : in Boolean);

         procedure Check_Counts
           (Expected_Parametric, Expected_Simple : in Natural);

         function Parametric_Fallback
           (Settings : in Strings.Settings;
            Name : in Atom;
            Arguments : in out Lockable.Descriptor'Class)
           return Boolean;

         function Simple_Fallback
           (Settings : in Strings.Settings;
            Name : in Atom)
           return Boolean;

         Parametric_Count : Natural := 0;
         Simple_Count : Natural := 0;

         Exp : constant Caches.Reference := Test_Tools.To_S_Expression
           ("(or"
            & "(and (starts-with a) non-existant)"
            & "(does-not-exist ohai ()))");

         procedure Check
           (Value : in String;
            With_Fallback : in Boolean)
         is
            Copy : aliased constant String := Value;
            Context : Strings.Context
              (Data => Copy'Access,
               Parametric_Fallback => (if With_Fallback
                                       then Parametric_Fallback'Access
                                       else null),
               Simple_Fallback     => (if With_Fallback
                                       then Simple_Fallback'Access
                                       else null));
         begin
            Context.Settings.Case_Sensitive := False;

            begin
               Check (Test, Context, Exp, "Fallback expression");

               if not With_Fallback then
                  Test.Fail ("Exception expected from """ & Value & '"');
               end if;
            exception
               when Constraint_Error =>
                  if With_Fallback then
                     raise;
                  end if;
            end;
         end Check;

         procedure Check_Counts
           (Expected_Parametric, Expected_Simple : in Natural) is
         begin
            if Parametric_Count /= Expected_Parametric then
               Test.Fail ("Parametric_Count is"
                 & Natural'Image (Parametric_Count) & ", expected"
                 & Natural'Image (Expected_Parametric));
            end if;

            if Simple_Count /= Expected_Simple then
               Test.Fail ("Simple_Count is"
                 & Natural'Image (Simple_Count) & ", expected"
                 & Natural'Image (Expected_Simple));
            end if;
         end Check_Counts;

         function Parametric_Fallback
           (Settings : in Strings.Settings;
            Name : in Atom;
            Arguments : in out Lockable.Descriptor'Class)
           return Boolean
         is
            pragma Unreferenced (Settings, Arguments);
         begin
            Parametric_Count := Parametric_Count + 1;
            return To_String (Name) = "does-not-exist";
         end Parametric_Fallback;

         function Simple_Fallback
           (Settings : in Strings.Settings;
            Name : in Atom)
           return Boolean
         is
            pragma Unreferenced (Settings);
         begin
            Simple_Count := Simple_Count + 1;
            return To_String (Name) = "non-existant";
         end Simple_Fallback;
      begin
         Check ("Oook?", False);
         Check ("Alice", False);
         Check ("Alpha", True);
         Check_Counts (0, 1);
         Check ("Bob", True);
         Check_Counts (1, 1);
      end;
   exception
      when Error : others => Test.Report_Exception (Error);
   end Fallbacks;

end Natools.S_Expressions.Conditionals.Strings.Tests;








Added tests/natools-s_expressions-conditionals-strings-tests.ads version [c35bd206ae].





































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

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

------------------------------------------------------------------------------
-- Copyright (c) 2015, Natacha Porté                                        --
--                                                                          --
-- Permission to use, copy, modify, and distribute this software for any    --
-- purpose with or without fee is hereby granted, provided that the above   --
-- copyright notice and this permission notice appear in all copies.        --
--                                                                          --
-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES --
-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF         --
-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR  --
-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES   --
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN    --
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  --
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.           --
------------------------------------------------------------------------------

------------------------------------------------------------------------------
-- Natools.S_Expressions.Conditionals.Strings.Tests provites a test suite   --
-- for conditionals on string objects.                                      --
------------------------------------------------------------------------------

with Natools.Tests;

package Natools.S_Expressions.Conditionals.Strings.Tests is

   package NT renames Natools.Tests;

   procedure All_Tests (Report : in out NT.Reporter'Class);

   procedure Basic_Usage (Report : in out NT.Reporter'Class);
   procedure Fallbacks (Report : in out NT.Reporter'Class);

end Natools.S_Expressions.Conditionals.Strings.Tests;













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