Merge pull request #205 from cgay/dev

Fix a few bugs

Author: cgay

assertions.dylan

@@ -521,8 +521,10 @@ define function do-check-condition
     phase := format-to-string("checking if expression %s signals a condition of class %s",
                               expr, condition-class);
     block ()
-      thunk();
-      let reason = "no condition signaled";
+      let (#rest v) = thunk();
+      let reason
+        = concatenate("no condition signaled; return values: ",
+                      join(v, ", ", key: curry(format-to-string, "%s")));
       record-check(description, $failed, reason);
       terminate? & assertion-failure(concatenate(caller, ": ", reason));
     exception (ex :: condition-class)

command-line.dylan

@@ -291,6 +291,12 @@ define function run-or-list-tests
     else
       report-function(result, *standard-output*);
     end;
+    if (*output-captured?*)
+      test-output("NOTE: Some test output was captured. See %s\n",
+                  file-locator(runner-temp-directory(runner),
+                               "*",
+                               $captured-output-filename));
+    end;
     if (result.result-status == $passed) 0 else 1 end
   end
 end function;

documentation/source/reference.rst

@@ -801,7 +801,7 @@ Test Execution
    temporary files created by the test or benchmark. The directory is created
    the first time this function is called for each test or benchmark and is not
    deleted after the test run is complete in case it's useful for post-mortem
-   analysis.  The directory is named ``_test/<user>-<timestamp>/<test-name>``
+   analysis.  The directory is named ``_test/<user>-<timestamp>.1/<test-name>``
    and is rooted at ``$DYLAN``, if defined, or in the current directory
    otherwise.
 

documentation/source/usage.rst

@@ -289,6 +289,36 @@ creating a test and provide a method that returns :drm:`#f` on Windows:
 Tests that aren't run because of the `when:` option are marked as ``SKIPPED`` in the
 results.
 
+Standard Output / Error
+~~~~~~~~~~~~~~~~~~~~~~~
+
+Any output to :var:`*standard-output*` or :var:`*standard-error*` during a test is
+automatically captured and stored in a file named :file:`_captured-stdout.txt` in the
+:func:`test's temporary directory <test-temp-directory>` so that it doesn't clutter the
+console output but also can be examined upon test failure.
+
+Temporary Files
+~~~~~~~~~~~~~~~
+
+If you need to create temporary files for a test, you can of course use the system temp
+directory, but after multiple test runs it may not be easy to figure out which is the
+correct file to look at when debugging your test.  Instead, use
+:func:`test-temp-directory` and its companion function :func:`write-test-file` to create
+the files in a directory created specifically for the test.
+
+Example:
+
+.. code:: dylan
+
+   define test test-something ()
+     let file = file-locator(test-temp-directory(), "something.txt");
+     write-test-file(file, contents: "hi there");
+     ...
+   end test;
+
+:func:`file-locator` is exported from the ``locators`` module of the ``system`` library.
+
+
 Benchmarks
 ----------
 

run.dylan

@@ -85,6 +85,10 @@ define open class <test-runner> (<object>)
   // to tests. For example, test data directory pathname.
   constant slot runner-options :: <string-table> = make(<string-table>),
     init-keyword: options:;
+
+  // A place to put temp files created by tests or the runner itself, one subdirectory
+  // per test.
+  constant slot runner-temp-directory :: <locator> = default-runner-temp-directory();
 end class <test-runner>;
 
 
@@ -250,14 +254,23 @@ define method execute-component
         add!(subresults, result);
         result
       end;
+    let ostream = make(<string-stream>, direction: #"output");
     let (status, reason)
       = dynamic-bind (*check-recording-function* = record-result,
                       *benchmark-recording-function* = record-result,
-                      *indent* = next-indent())
+                      *indent* = next-indent(),
+                      // This (intentionally) doesn't affect `test-output` because it
+                      // uses `runner-output-stream`.
+                      *standard-output* = ostream,
+                      *standard-error* = ostream)
           let cond
             = profiling (cpu-time-seconds, cpu-time-microseconds, allocation)
                 block ()
                   test.test-function();
+                cleanup
+                  let output = stream-contents(ostream);
+                  ~empty?(output)
+                    & write-captured-output(output);
                 exception (err :: <assertion-failure>,
                            test: curry(handle-condition?, runner))
                   // An assertion failure causes the remainder of a test to be

tests/testworks-test-suite.dylan

@@ -745,6 +745,9 @@ define test test-write-test-file ()
   assert-equal("abc", fs/with-open-file (stream = y)
                         read-to-end(stream)
                       end);
+
+  let z = write-test-file("1/2/3", contents: "123");
+  assert-equal(file-locator(test-temp-directory(), "1", "2", "3"), z);
 end test;
 
 define test test-register-component--duplicate-test-name-causes-error ()

utils.dylan

@@ -120,27 +120,44 @@ define function next-indent () => (indent :: <string>)
   concatenate(*indent*, $indent-step)
 end function;
 
-// Return a temporary directory unique to the current test or benchmark. The
-// directory is created the first time this is called for a given test.
-// The directory is _test/<user>-<yyyymmdd-hhmmss>/<full-test-name>/, relative
-// to ${DYLAN}/, if defined, or relative to fs/working-directory() otherwise.
+define function default-runner-temp-directory () => (dir :: <directory-locator>)
+  let dylan = os/environment-variable("DYLAN");
+  let base = if (dylan)
+               as(<directory-locator>, dylan)
+             else
+               fs/working-directory()
+             end;
+  let dated-dir
+    = concatenate(os/login-name() | "unknown",
+                  "-",
+                  date/format("%Y%m%d-%H%M%S", date/now()));
+  // We could just include milliseconds (%F) in the date format below but currently
+  // <date> milliseconds are always zero, at least on Unix.
+  // https://github.com/dylan-lang/testworks/issues/199
+  iterate loop (i = 1)
+    let uniquifier = format-to-string("%s.%d", dated-dir, i);
+    let dir = subdirectory-locator(base, "_test", uniquifier);
+    if (block ()
+          fs/file-exists?(dir)
+        exception (ex :: fs/<file-system-error>)
+          #f
+        end)
+      loop(i + 1)
+    else
+      dir
+    end
+  end
+end function;
+
+// Return a temporary directory unique to the current test or benchmark.
 define function test-temp-directory () => (d :: false-or(<directory-locator>))
   if (instance?(*component*, <runnable>))
-    let dylan = os/environment-variable("DYLAN");
-    let base = if (dylan)
-                 as(<directory-locator>, dylan)
-               else
-                 fs/working-directory()
-               end;
-    let uniquifier
-      = format-to-string("%s-%s", os/login-name() | "unknown",
-                         date/format("%Y%m%d-%H%M%S", date/now()));
     let safe-name = map(method (c)
                           if (c == '\\' | c == '/') '_' else c end
                         end,
                         component-name(*component*));
     let test-directory
-      = subdirectory-locator(base, "_test", uniquifier, safe-name);
+      = subdirectory-locator(runner-temp-directory(*runner*), safe-name);
     fs/ensure-directories-exist(test-directory);
     test-directory
   end
@@ -165,9 +182,8 @@ define function write-test-file
   locator
 end function;
 
-// For tests to do debugging output.
-// TODO(cgay): Collect this and stdio into a log file per test run
-// or per test.  The Surefire report has a place for stdout, too.
+// For output to the main output stream for the test run.  That is, this output is never
+// redirected to the _captured-stdout.txt file in a test's temp directory.
 define method test-output
     (format-string :: <string>, #rest format-args) => ()
   let stream = if (*runner*)
@@ -180,3 +196,17 @@ define method test-output
     force-output(stream);
   end;
 end method;
+
+define constant $captured-output-filename :: <string> = "_captured-stdout.txt";
+
+define variable *output-captured?* :: <boolean> = #f;
+
+define function write-captured-output (output :: <string>)
+  block ()
+    let file = file-locator(test-temp-directory(), $captured-output-filename);
+    write-test-file(file, contents: output);
+    *output-captured?* := #t;
+  exception (err :: <error>)
+    test-output("ERROR writing to test's output file: %s\n%s\n", err, output);
+  end;
+end function;