Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

Merge pull request #3 from cgay/assertions

Use constants for passed, failed, et al.
  • Loading branch information...
commit bf5f0ffa8a6743f526e67041a685a98982baa43f 2 parents e035b03 + 385758b
Bruce Mitchener authored November 02, 2012
8  benchmarks.dylan
@@ -49,13 +49,13 @@ define method do-benchmark
49 49
           result := maybe-trap-errors(apply(function, arguments));
50 50
         results
51 51
           status := if (~result)
52  
-                      #"failed"
  52
+                      $failed
53 53
                     elseif (instance?(result, <error>))
54 54
                       result
55 55
                     else
56  
-                      #"passed"
  56
+                      $passed
57 57
                     end if;
58  
-          if (status == #"failed" & debug-failures?())
  58
+          if (status == $failed & debug-failures?())
59 59
             break("Benchmark failed: %s", name)
60 60
           end if;
61 61
           record-benchmark(name, status, function, arguments,
@@ -66,7 +66,7 @@ define method do-benchmark
66 66
   exception (r :: <simple-restart>,
67 67
              init-arguments: vector(format-string:, "Skip this benchmark",
68 68
                                     format-arguments:, #[]))
69  
-    #"failed"
  69
+    $failed
70 70
   end block;
71 71
 end method do-benchmark;
72 72
 
22  checks.dylan
@@ -113,13 +113,13 @@ define method do-check
113 113
         let result = maybe-trap-errors(apply(function, arguments));
114 114
         let status :: <result-status>
115 115
           = if (~result)
116  
-              #"failed"
  116
+              $failed
117 117
             elseif (instance?(result, <error>))
118 118
               result
119 119
             else
120  
-              #"passed"
  120
+              $passed
121 121
             end if;
122  
-        if (status == #"failed" & debug-failures?())
  122
+        if (status == $failed & debug-failures?())
123 123
           break("Check failed: %s", name)
124 124
         end if;
125 125
         record-check(name, status, function, arguments)
@@ -127,7 +127,7 @@ define method do-check
127 127
   exception (r :: <simple-restart>,
128 128
              init-arguments: vector(format-string:, "Skip this check",
129 129
                                     format-arguments:, #[]))
130  
-    #"failed"
  130
+    $failed
131 131
   end block;
132 132
 end method do-check;
133 133
 
@@ -172,16 +172,16 @@ define method do-check-condition
172 172
             let handler condition-class
173 173
                = method (condition :: <condition>, next-handler :: <function>)
174 174
                    ignore(condition, next-handler);
175  
-                   return(#"passed")
  175
+                   return($passed)
176 176
                  end;
177 177
             body-of-check();
178  
-            #"failed"
  178
+            $failed
179 179
           exception (r :: <simple-restart>,
180 180
                      init-arguments: vector(format-string:, "Skip this check",
181 181
                                             format-arguments:, #[]))
182  
-            #"failed"
  182
+            $failed
183 183
           end block;
184  
-      if (result == #"failed" & debug-failures?())
  184
+      if (result == $failed & debug-failures?())
185 185
         break("Check condition failed: %s (%s)",
186 186
               name,
187 187
               format-to-string("Expected %s to be signaled but got %s.",
@@ -212,7 +212,7 @@ define method failure-reason
212 212
 end method failure-reason;
213 213
 
214 214
 define method failure-reason
215  
-    (status == #"failed",
  215
+    (status == $failed,
216 216
      operation :: <function>,
217 217
      value :: <check-value-type>)
218 218
  => (reason :: false-or(<string>))
@@ -229,7 +229,7 @@ define method failure-reason
229 229
 end method failure-reason;
230 230
 
231 231
 define method failure-reason
232  
-    (status == #"failed",
  232
+    (status == $failed,
233 233
      operation :: subclass(<condition>),
234 234
      value :: <check-value-type>)
235 235
  => (reason :: false-or(<string>))
@@ -296,7 +296,7 @@ define method print-check-progress
296 296
   let status = result.result-status;
297 297
   let name = result.result-name;
298 298
   select (status)
299  
-    #"not-executed" =>
  299
+    $skipped =>
300 300
       test-output("Ignored check: %s", name);
301 301
     otherwise =>
302 302
       test-output("Ran check: %s %s", name, status-name(status));
2  components.dylan
@@ -103,7 +103,7 @@ define method maybe-execute-component
103 103
     = if (execute-component?(component, options))
104 104
         execute-component(component, options)
105 105
       else
106  
-        values(#(), #"not-executed")
  106
+        values(#(), $skipped)
107 107
       end;
108 108
   make-result(component, subresults, perform-status)
109 109
 end method maybe-execute-component;
4  report/initialize.dylan
@@ -349,12 +349,12 @@ define method find-named-result
349 349
       let passed?
350 350
         = every?(method (subresult)
351 351
                    let status = subresult.result-status;
352  
-                   status = #"passed" | status = #"not-executed"
  352
+                   status = $passed | status = $skipped
353 353
                  end,
354 354
                  results);
355 355
       make(<suite-result>,
356 356
            name: "[Specified tests/suites]",
357  
-           status: if (passed?) #"passed" else #"failed" end,
  357
+           status: if (passed?) $passed else $failed end,
358 358
            subresults: results);
359 359
   end
360 360
 end method find-named-result;
12  report/log-reader.dylan
@@ -12,14 +12,16 @@ define constant $testworks-message
12 12
   = "Make sure the test report was generated using the \"-report log\"\n"
13 13
     "or \"-report xml\" option to testworks.";
14 14
 
  15
+// It looks like this and testworks:status-name are meant to be
  16
+// inverses.
15 17
 define method parse-status
16 18
     (status-string :: <string>, reason)
17 19
   select (status-string by \=)
18  
-    "passed"          => #"passed";
19  
-    "failed"          => #"failed";
20  
-    "not executed"    => #"not-executed";
21  
-    "crashed"         => recreate-error(reason);
22  
-    "not implemented" => #"not-implemented";
  20
+    "passed" => $passed;
  21
+    "failed" => $failed;
  22
+    "skipped" => $skipped;
  23
+    "crashed" => recreate-error(reason);
  24
+    "not implemented" => $not-implemented;
23 25
     otherwise =>
24 26
       error("Unexpected status '%s' in report", status-string);
25 27
   end
2  report/reports.dylan
@@ -53,7 +53,7 @@ end method print-result-reason;
53 53
 
54 54
 define method print-result-reason
55 55
     (name :: <string>, result :: <benchmark-result>, #key indent = "") => ()
56  
-  if (result.result-status ~== #"passed")
  56
+  if (result.result-status ~== $passed)
57 57
     next-method();
58 58
   else
59 59
     format-out("%s  %s %s in %s seconds, %d bytes allocated\n",
25  reports.dylan
@@ -55,11 +55,16 @@ define method count-results
55 55
   do-results
56 56
     (method (result)
57 57
        select (result.result-status)
58  
-         #"passed"          => passes          := passes       + 1;
59  
-         #"failed"          => failures        := failures     + 1;
60  
-         #"not-executed"    => not-executed    := not-executed + 1;
61  
-         #"not-implemented" => not-implemented := not-implemented + 1;
62  
-         otherwise          => crashes         := crashes      + 1;
  58
+         $passed =>
  59
+           passes := passes + 1;
  60
+         $failed =>
  61
+           failures := failures + 1;
  62
+         $skipped =>
  63
+           not-executed := not-executed + 1;
  64
+         $not-implemented =>
  65
+           not-implemented := not-implemented + 1;
  66
+         otherwise =>
  67
+           crashes := crashes + 1;
63 68
        end
64 69
      end,
65 70
      result,
@@ -184,7 +189,7 @@ define method print-benchmark-results
184 189
               let name = result-name(bench);
185 190
               let time = result-time(bench);
186 191
               let sbytes = result-bytes(bench) & integer-to-string(result-bytes(bench));
187  
-              if (result-status(bench) == #"passed")
  192
+              if (result-status(bench) == $passed)
188 193
                 let (newsec, newusec) = addtimes(seconds, microseconds, sec, usec);
189 194
                 seconds := newsec;
190 195
                 microseconds := newusec;
@@ -243,7 +248,7 @@ define method print-result-summary
243 248
               if (total-results == 1) ": " else "s: " end,
244 249
               passes);
245 250
   print-percentage(passes, total-results);
246  
-  test-output("), %d failed, %d not executed, %d not implemented, %d crashed\n",
  251
+  test-output("), %d failed, %d skipped, %d not implemented, %d crashed\n",
247 252
               failures, not-executed, not-implemented, crashes);
248 253
 end method print-result-summary;
249 254
 
@@ -263,7 +268,7 @@ define method print-result-info
263 268
   if (show-result?)
264 269
     test-output("\n%s%s %s",
265 270
                 indent, result.result-name, status-name(result-status));
266  
-    if (result-status == #"passed"
  271
+    if (result-status == $passed
267 272
         & instance?(result, <benchmark-result>))
268 273
       test-output(" in %s seconds with %d bytes allocated.",
269 274
                   result-time(result), result-bytes(result) | 0);
@@ -306,14 +311,14 @@ end method summary-report-function;
306 311
 define method failures-report-function (result :: <result>) => ()
307 312
   test-output("\n");
308 313
   select (result.result-status)
309  
-    #"passed" =>
  314
+    $passed =>
310 315
       test-output("%s passed\n", result.result-name);
311 316
     otherwise =>
312 317
       print-result-info
313 318
         (result, 
314 319
          test: method (result)
315 320
                  let status = result.result-status;
316  
-                 status ~== #"passed" & status ~== #"not-executed"
  321
+                 status ~== $passed & status ~== $skipped
317 322
                end);
318 323
       test-output("\n");
319 324
   end;
8  suites.dylan
@@ -177,15 +177,15 @@ define method execute-component
177 177
         end;
178 178
         case
179 179
           empty?(subresults) =>
180  
-            #"not-implemented";
  180
+            $not-implemented;
181 181
           every?(method (subresult)
182 182
                    let status = subresult.result-status;
183  
-                   status = #"passed" | status = #"not-executed"
  183
+                   status = $passed | status = $skipped
184 184
                  end,
185 185
                  subresults) =>
186  
-            #"passed";
  186
+            $passed;
187 187
           otherwise =>
188  
-            #"failed"
  188
+            $failed
189 189
         end
190 190
       cleanup
191 191
         suite.suite-cleanup-function();
8  tests.dylan
@@ -186,14 +186,14 @@ define method execute-component
186 186
           instance?(cond, <serious-condition>) =>
187 187
             cond;
188 188
           empty?(subresults) & ~test.test-allow-empty? =>
189  
-            #"not-implemented";
  189
+            $not-implemented;
190 190
           every?(method (result :: <unit-result>) => (passed? :: <boolean>)
191  
-                   result.result-status == #"passed"
  191
+                   result.result-status == $passed
192 192
                  end, 
193 193
                  subresults) =>
194  
-            #"passed";
  194
+            $passed;
195 195
           otherwise =>
196  
-            #"failed"
  196
+            $failed
197 197
         end
198 198
       end;
199 199
   values(subresults, status)
35  tests/testworks-test-suite.dylan
@@ -60,12 +60,12 @@ define test testworks-check-true-test ()
60 60
               without-recording ()
61 61
                 check-true($internal-check-name, #t)
62 62
               end,
63  
-              #"passed");
  63
+              $passed);
64 64
   check-equal("check-true(#f) fails",
65 65
               without-recording ()
66 66
                 check-true($internal-check-name, #f)
67 67
               end,
68  
-              #"failed");
  68
+              $failed);
69 69
   check-true("check-true of error crashes",
70 70
              instance?(without-recording ()
71 71
                          check-true($internal-check-name, 
@@ -79,12 +79,12 @@ define test testworks-check-false-test ()
79 79
               without-recording ()
80 80
                 check-false($internal-check-name, #t)
81 81
               end,
82  
-              #"failed");
  82
+              $failed);
83 83
   check-equal("check-false(#f) passes",
84 84
               without-recording ()
85 85
                 check-false($internal-check-name, #f)
86 86
               end,
87  
-              #"passed");
  87
+              $passed);
88 88
   check-true("check-false of error crashes",
89 89
              instance?(without-recording ()
90 90
                          check-false($internal-check-name, 
@@ -98,17 +98,17 @@ define test testworks-check-equal-test ()
98 98
               without-recording ()
99 99
                 check-equal($internal-check-name, 1, 1)
100 100
               end,
101  
-              #"passed");
  101
+              $passed);
102 102
   check-equal("check-equal(\"1\", \"1\") passes",
103 103
               without-recording ()
104 104
                 check-equal($internal-check-name, "1", "1")
105 105
               end,
106  
-              #"passed");
  106
+              $passed);
107 107
   check-equal("check-equal(1, 2) fails",
108 108
               without-recording ()
109 109
                 check-equal($internal-check-name, 1, 2)
110 110
               end,
111  
-              #"failed");
  111
+              $failed);
112 112
   check-true("check-equal of error crashes",
113 113
              instance?(without-recording ()
114 114
                          check-equal($internal-check-name, 
@@ -123,12 +123,12 @@ define test testworks-check-instance?-test ()
123 123
               without-recording ()
124 124
                 check-instance?($internal-check-name, <integer>, 1)
125 125
               end,
126  
-              #"passed");
  126
+              $passed);
127 127
   check-equal("check-instance?(1, <string>) fails",
128 128
               without-recording ()
129 129
                 check-instance?($internal-check-name, <string>, 1)
130 130
               end,
131  
-              #"failed");
  131
+              $failed);
132 132
   check-true("check-instance? of error crashes",
133 133
              instance?(without-recording ()
134 134
                          check-instance?($internal-check-name, 
@@ -151,7 +151,7 @@ define test testworks-check-condition-test ()
151 151
                                   test-error()
152 152
                                 end)
153 153
               end,
154  
-              #"passed");
  154
+              $passed);
155 155
   check-true("check-condition for <error> doesn't catch <warning>", success?);
156 156
   check-equal("check-condition fails if no condition",
157 157
               without-recording ()
@@ -159,7 +159,7 @@ define test testworks-check-condition-test ()
159 159
                                 <test-error>,
160 160
                                 #f)
161 161
               end,
162  
-              #"failed");
  162
+              $failed);
163 163
   check-condition("check-condition doesn't catch wrong condition",
164 164
                   <warning>,
165 165
                   without-recording ()
@@ -174,12 +174,12 @@ define test testworks-check-no-errors-test ()
174 174
               without-recording ()
175 175
                 check-no-errors($internal-check-name, #t)
176 176
               end,
177  
-              #"passed");
  177
+              $passed);
178 178
   check-equal("check-no-errors of #f passes",
179 179
               without-recording ()
180 180
                 check-no-errors($internal-check-name, #f)
181 181
               end,
182  
-              #"passed");
  182
+              $passed);
183 183
   check-true("check-no-errors of error crashes",
184 184
              instance?(without-recording ()
185 185
                          check-no-errors($internal-check-name, 
@@ -198,6 +198,7 @@ define suite testworks-check-macros-suite ()
198 198
   test testworks-check-no-errors-test;
199 199
 end suite testworks-check-macros-suite;
200 200
 
  201
+
201 202
 
202 203
 /// Verify the result objects
203 204
 
@@ -207,8 +208,8 @@ define test testworks-perform-test-results-test ()
207 208
     = perform-test(test-to-check, progress-function: #f, report-function: #f);
208 209
   check-true("perform-test returns <test-result>", 
209 210
              instance?(test-results, <test-result>));
210  
-  check-equal("perform-test returns #\"passed\" when passing", 
211  
-              test-results.result-status, #"passed");
  211
+  check-equal("perform-test returns $passed when passing", 
  212
+              test-results.result-status, $passed);
212 213
   check-true("perform-test sub-results are in a vector", 
213 214
              instance?(test-results.result-subresults, <vector>))
214 215
 end test testworks-perform-test-results-test;
@@ -219,8 +220,8 @@ define test testworks-perform-suite-results-test ()
219 220
     = perform-suite(suite-to-check, progress-function: #f, report-function: #f);
220 221
   check-true("perform-suite returns <suite-result>", 
221 222
              instance?(suite-results, <suite-result>));
222  
-  check-equal("perform-suite returns #\"passed\" when passing", 
223  
-              suite-results.result-status, #"passed");
  223
+  check-equal("perform-suite returns $passed when passing", 
  224
+              suite-results.result-status, $passed);
224 225
   check-true("perform-suite sub-results are in a vector", 
225 226
              instance?(suite-results.result-subresults, <vector>))
226 227
 end test testworks-perform-suite-results-test;
1  testworks-lib.dylan
@@ -96,6 +96,7 @@ define module testworks
96 96
          result-name,
97 97
          result-type-name,
98 98
          result-status,
  99
+              $passed, $failed, $skipped, $not-implemented, $crashed,
99 100
          result-seconds,
100 101
          result-microseconds,
101 102
          result-time,
26  testworks.dylan
@@ -19,21 +19,27 @@ define constant <check-value-type>
19 19
 
20 20
 /// Result handling
21 21
 
  22
+define constant $passed = #"passed";
  23
+define constant $failed = #"failed";
  24
+define constant $crashed = #"crashed";
  25
+define constant $skipped = #"skipped";
  26
+define constant $not-implemented  = #"nyi";
  27
+
  28
+// TODO(cgay): Get rid of type-union, just store the condition
  29
+// and use $crashed in the one-of.
22 30
 define constant <result-status>
23  
-  = type-union(one-of(#"passed",
24  
-                      #"failed",
25  
-                      #"not-executed",
26  
-                      #"not-implemented"),
27  
-               <condition>);
  31
+  = type-union(one-of($passed, $failed, $skipped, $not-implemented), <condition>);
28 32
 
  33
+// It looks like this and testworks-reports:parse-status are meant to
  34
+// be inverses.
29 35
 define method status-name
30 36
     (status :: <result-status>) => (name :: <string>)
31 37
   select (status)
32  
-    #"passed"       => "passed";
33  
-    #"failed"       => "failed";
34  
-    #"not-executed" => "not executed";
35  
-    #"not-implemented" => "not implemented";
36  
-    otherwise       => "crashed";
  38
+    $passed => "passed";
  39
+    $failed => "failed";
  40
+    $skipped => "skipped";
  41
+    $not-implemented => "not implemented";
  42
+    otherwise => "crashed";
37 43
   end
38 44
 end method status-name;
39 45
 

0 notes on commit bf5f0ff

Please sign in to comment.
Something went wrong with that request. Please try again.