runt.icn

############################################################################
#
#   File:     runt.icn
#
#   Subject:  Run all the test_*.icn for which there is a matching
#             test_*.std
#
#   Author:   Arthur C. Eschenlauer
#
#   Date:     October 1, 2021
#
############################################################################
#
#   This file is in the public domain.
#
#   SPDX-License-Identifier: CC-PDDC
#     https://spdx.org/licenses/CC-PDDC.html
#
############################################################################
#
#   Working examples, named `test_*.icn`, are in the `tests` directory:
#
#   - `test_*.std` captures the corresponding test's expected output.
#   - `icon runt.icn tests` will run the tests and compare the results to
#      their expected output.
#   - usage: `icon runt.icn [--continue] [--verbose] [<zero or more dirs>]`
#     - By default, tests are located and run in the current working
#       directory.
#       - Otherwise, tests are located and run in the specified directory
#         or directories.
#     - Tests are not run unless an `.icn` file and a `.std` file share
#       exactly the same name.
#     - Use the `--continue` option to run all tests regardless of whether
#       any fail.
#     - Use the `--verbose` option to show both the expected output from
#       the `.std` file and the actual output produced by the test program.
#
############################################################################
#
#   links: showtbl
#   requried includes: fileDirIo.icn
#
############################################################################

$include "fileDirIo.icn"
$include "lindel.icn"

$define USAGE  "usage: icon runt.icn [--continue] [--verbose] dir_names [test_names]"
$define USAGE1 "      --continue: run other tests after a test fails"
$define USAGE2 "      --verbose: trace test results"
$define USAGE3 "      --help - print this message"
$define USAGE4 "Any test_names supplied constitute an exclusive list of tests"
$define USAGE5 "to run; e.g., to run only test_baton and test_baton_main, type:"
$define USAGE6 "  runt tests baton baton_main"

#$define HIDE_CMDLINE &fail
$define HIDE_CMDLINE &null
#$define SHOW_TIMINGS &fail
$define SHOW_TIMINGS &null

$ifndef _UNIX
  $ifdef _MS_WINDOWS         # _MS_WINDOWS
    $ifdef _MS_WINDOWS_NT    # _MS_WINDOWS and _MS_WINDOWS_NT
      # e.g., for Unicon on MS Windows
      $define SET_LPATH "set LPATH=" || workingdir || "&& "
    $else                    # _MS_WINDOWS but not _MS_WINDOWS_NT
      # e.g., for portableIcon on MS Windows
      # kludge: if PATH starts with a lowercase drive letter, path search
      #   fails; however, beginning with a semicolon hacks the issue away.
      #   This could not be addressed via smudge.cmd. Is it a Cygnal issue?
      $define SET_LPATH "set PATH=;%PATH%&& set LPATH="||workingdir||"&& "
    $endif
  $else                      # neither _MS_WINDOWS nor _UNIX
    # e.g. for unknown POSIX shell ...
    $define SET_LPATH "LPATH=" || workingdir || " "
  $endif
$else                        # _UNIX
  # e.g., for Linux, FreeBSD, or MacOS
  $define SET_LPATH "LPATH=" || workingdir || " "
$endif

link showtbl # for procedure showtbl

# flag that exit should produce error status even with --continue argument
global failure, portableIcon, win_unicon

# run all the test_*.icn for which there is a matching test_*.std
procedure main(args)
  local abort       # if !args == "--continue" then write else stop
  local bespoke     # names of individual tests to run rather than all
  local cmd         # scratch variable for tracing commands
  local dir         # one member of dirs
  local dirEntry    # entry in current working directory
  local dirListing  # names of files and subdirectores in CWD
  local dirs        # list args matching directory names
  local filExpected # file with expected results, test_*.std
  local filObserved # file producing observed results, test_*.icn
  local linCount    # line counter
  local linExpected # expected line
  local linObsC     # sequence of observed lines
  local linObserved # observed line
  local testName    # name of test, test_*
  local traceout    # if !args == "--verbose" then write else 2
  local timings     # for test-timing report
  local totalTime   # for test-timing report
  local workingdir  # current working directory, read from PWD
  if *args < 1 | !args == "--help" then {
    write(USAGE)
    write(USAGE1)
    write(USAGE2)
    write(USAGE3)
    write(USAGE4)
    write(USAGE5)
    write(USAGE6)
    exit(if *args < 1 then 1 else 0)
  }

  traceout :=
    if !args == "--verbose" then write else 2
  abort :=
    if !args == "--continue" then write_abort else stop
  if traceout === 2
    then
      write( &errout, "To trace output,  invoke as:   icon "
           , &progname, " --verbose")
    else
      every dir := Lfind(args, "--verbose")
        do args := Ldelete(args, dir, )
  if abort === stop
    then
      write( &errout, "To run all tests, invoke as:   icon "
           , &progname, " --continue")
    else
      every dir := Lfind(args, "--continue")
        do args := Ldelete(args, dir, )
  win_unicon := (&features == "MS Windows NT", &features == "POSIX")
  portableIcon := (
    &features == "MS Windows",
    &features == "Cygwin"
    , not (&features == "MS Windows NT")
    , not (&features == "POSIX")
    , not (&features == "UNIX")
    , 1
    )
  if SHOW_TIMINGS & \win_unicon
    then
      write(&errout,
        "Windows Unicon detected; pipes & co-expressions may fail")
    else
      if \win_unicon
        then
          write(&errout,
            "Windows Unicon detected; pipe & co-expressions may fail")
  # timing support
  totalTime := -&time
  timings := table(-1)
  # dirs either lists the directory arguments or the current directory
  dirs := []
  every put(dirs, directory_seq(!args) || path_separator())
  if *dirs == 0
    then dirs := put( dirs, "." || path_separator())
  # prepare for specification of individual tests, if any
  bespoke := []
  every testName := !args
    do
      if not directory_seq(testName)
        then put(bespoke, "test_" || testName || ".icn")
  workingdir := pwd() # getenv("PWD")
  every dir := !dirs
    do {
      chdir(workingdir) | (
        write("Could not change to working directory: ", workingdir) & next)
      chdir(dir) | (write("Could not change to directory: ", dir) & next)
      # For each file in the directory
      every dirEntry := !(dirListing := open(".")) do {
        # All paths should be relative to the directory-under-test
        # If "bespoke" is of length > 0, skip tests not in list
        if (*bespoke > 0, not(dirEntry == !bespoke))
          then next
        # Assume it's a test file if its name begins with "test";
        #   check that it ends with ".icn"
        if dirEntry ?
             dirEntry == ( testName := ="test_" || tab(find(".icn")) ) || =".icn"
          then (
            # Write nothing unless we find a .std file
            filExpected := open( testName || ".std")
            # Report that we will run the test
          , write("::: Running ", testName)
          , timings[testName] := -&time
            # Prepare to generate the observed result lines
          , &trace := -1
          #, write(&errout, "... ante")
          , if \win_unicon # only for Unicon on Microsoft Windows NT
              then (
                remove(testName || ".bat") | 1,
                remove(testName || ".exe") | 1,
                system(SET_LPATH || "unicon -s -u " || testName || ".icn"),
                delay(100),
                system(testName || " > " || testName || ".out")
                )
            else if \portableIcon
              then ( # portableIcon
                system(
                  SET_LPATH || "icont -s -u " || testName ||
                    ".icn && call " || testName || ".bat" ||
                    " > " || testName || ".out"
                  )
                )
              else ( # Icon
                if (
                    cmd <- SET_LPATH || "icont -s -u " || testName || ".icn",
                    HIDE_CMDLINE | write(&errout, "  building: " || \cmd),
                    0 = system(\cmd) | break failure := -1
                    #, write(&errout, "... building returned zero")
                    )
                  then (
                    cmd <- SET_LPATH || "./" || testName || " > " || testName || ".out",
                    HIDE_CMDLINE | write(&errout, "  running:  " || \ cmd),
                    0 = system(\cmd) | break failure := -1
                    #, write(&errout, "... running returned zero"),
                    )
                  else break failure := -1
                )
          , &trace := 0
          #, write(&errout, "... post")
          , filObserved := open(testName || ".out", "r")
            # Create a sequence of expected result lines
          , linObsC := create traceout("  observed: ", !filObserved)
          , linCount := 0
            # For each observed result line, abort if expected line does not match
          , ( every linExpected := traceout("  expected: ", !filExpected) do {
                linCount +:= 1
                # termination is premature if expected line is not observed
                linObserved := @linObsC | (
                  abort( " ... line ", linCount
                       , ": premature termination, expected: '"
                       , linExpected, "'"
                       , if /win_unicon then "" else
                          " (Windows Unicon pipe or co-expression may have failed.)"
                       )
                , break
                )
                # abort when expected line does not match observed
                (
                  abort( " ... line ", linCount, ": '"
                       , linExpected ~== linObserved
                       , "' was produced but '"
                       , linExpected
                       , "' was expected\n"
                       ) & break
                ) | next
              }
            ) | if linObserved := @linObsC
                  # report unexpected output
                  then
                    abort( " ... line ", linCount
                         , ": unexpected output: '", linObserved, "'\n"
                         )
                  else {
                    timings[testName] +:= &time
                    write("    Passed")
                    }
          )
        remove(testName || ".out")
      }
      close(\dirListing)
    }
  if SHOW_TIMINGS & /win_unicon
    then{
      # from IPL procs showtbl.icn
      showtbl(
        "approx. runtimes, mS", #  1 title      heading title      ""
        timings,                #  2 tbl        table to be shown  NO DEFAULT
        ,                       #  3 sort_type  type of sorting    "ref"/"val"
        ,                       #  4 limit      lines of output    infinite
        ,                       #  5 sort_order increasing?        "incr"/"decr"
        ,                       #  6 posit      first column       "val"/"ref"
        40,                     #  7 w1         width of 1st col   10
        ,                       #  8 w2         width of 2nd col   10
        ,                       #  9 gutter     width between cols 3
        right,                  # 10 f1         f justify 1st col  left
        left,                   # 11 f2         f justify 2nd col  right
        )
      write("\nTotal testing time (milliseconds, within whatever resolution): ", totalTime +:= &time)
      }

  if /failure
    then {
      write()
      write("All tests passed. Yippee!!")
      }
  # exit code zero unless falure was encountered when abort === write_abort
  exit( \failure | 0)
end

# record that an error occurred
procedure write_abort(ls[])
  failure := 1
  write ! ls
  return failure
end