##-
# Author: Brian Tiffin
# Dedicated to the public domain
#
# Date: September 2016
# Version: 0.6
# Modified: 2017-07-24/17:48-0400 btiffin
##+
#
# unitest.icn, Unicon unit testing
#
link fullimag, lists

# test suite container, and testresults aggregate
record testcontrol(testname, speaktest, looplimit, xmlout, testcases)
record testresults(control, trials, skips, 
                   errors, pass, fails, breaks)
global testlabel

procedure testsuite(testname, speak, looplimit, xmlout)
    local control, suite
    testlabel := create ("test-" || seq())
    control := testcontrol(testname, speak, looplimit, xmlout, [])
    suite := testresults(control, 0, 0, 0, 0, 0, 0)
    return suite
end

#
# single result testing
#
procedure test(suite, code, arglist, result, output, error)
    suite.trials +:= 1
    put(suite.control.testcases, [@testlabel, 0, &null])

    if suite.control.speaktest > 0 then {
        write(repl("#", 18), " Test: ", right(suite.trials, 4), " ",
              repl("#", 18))
        writes(image(code))
        if \arglist then write("!", fullimage(arglist)) else write()
        if \result then write("Expecting: ", result)
    }

    case type(code) of {
        "string"    : task := uval(code)
        "procedure" : task := create code!arglist
        default     : testFailure("Unknown code type: " || type(code))
    }

    if \task then {
        suite.control.testcases[*suite.control.testcases][2] :=
            gettimeofday()
        # fetch a result
        r := @task
        if \result then
            if r === result then pass(suite) else fails(suite)
        else pass(suite)
        suite.control.testcases[suite.trials][2] := 
            bigtime(suite.control.testcases[suite.trials][2])
    } else errors(suite)

    if suite.control.speaktest > 0 then {
        if \result then write("Received: ", type(r), ", ", image(r))
        write("Trials: ", suite.trials, " Errors: ", suite.errors,
              "  Pass: ", suite.pass, " Fail: ", suite.fails)
        write(repl("#", 48), "\n")
    }
end

#
# record a pass
#
procedure pass(suite)
    suite.pass +:= 1
end

#
# record a fail
#
procedure fails(suite)
    suite.fails +:= 1
    suite.control.testcases[suite.trials][3] := 1
end
 
#
# record an error
#
procedure errors(suite)
    suite.errors +:= 1
    suite.control.testcases[suite.trials][3] := 2
end

#
# report, summary and possibly XML
#
procedure testreport(suite)
    write("Trials: ", suite.trials, " Errors: ", suite.errors,
          "  Pass: ", suite.pass, " Fail: ", suite.fails)
    write()

    if suite.control.xmlout > 0 then {
        write("<?xml version=\"1.0\" encoding=\"UTF-8\"?>")
        write("<testsuite name=\"", suite.control.testname,
              "\" tests=\"", suite.trials,
              "\" errors=\"", suite.errors, "\" failures=\"", suite.fails,
              "\" skip=\"", suite.skips, "\">")
        every testcase := !suite.control.testcases do {
            write("    <testcase classname=\"", &progname,
                  "\" name=\"", testcase[1], "\" time=\"", testcase[2], "\">")
            if \testcase[3] = 1 then {
                write("        <failure type=\"unitest\"> unitest failure </failure")
            }
            if \testcase[3] = 2 then {
                write("        <error type=\"unicon\" message=\"code error\">")
                write("            CodeError: code problem")
                write("        </error>")
            }
            write("    </testcase>")
        }
        write("</testsuite>")
    }
end

#
# Multiple result testing
#
procedure tests(suite, code, arglist, result, output, error)
    suite.trials +:= 1
    put(suite.control.testcases, [@testlabel, 0, &null])
    if suite.control.speaktest > 0 then {
        write(repl("#", 8), " Generator test: ", right(suite.trials, 4),
              " ", repl("#", 18))
        writes(image(code))
        if \arglist then write("!", fullimage(arglist)) else write()
        if \result then write("Expecting: ", limage(result))
    }

    case type(code) of {
        "string"    : task := uvalGenerator(code)
        "procedure" : task := create code!arglist
        default     : testFailure("Unknown code type: " || type(code))
    }

    resultList := list()
    loops := 0;
    if \task then {
        suite.control.testcases[suite.trials][2] :=
            gettimeofday()
        # fetch a result list
        while put(resultList, @task) do {
            loops +:= 1
            if loops > suite.control.looplimit > 0 then {
                suite.breaks +:= 1
                pull(resultList)
                break &null
                # should limiter breaks ever count as a pass?  todo
            }
        }
        if \result then
            if lequiv(resultList, result) then pass(suite) else fails(suite)
        else pass(suite)
        suite.control.testcases[suite.trials][2] := 
            bigtime(suite.control.testcases[suite.trials][2])
    } else errors(suite)

    if suite.control.speaktest > 0 then {
        if \result then write("Received: ", limage(resultList))
        write("Trials: ", suite.trials, "  Errors: ", suite.errors,
              "  Limits: ", suite.breaks,
              "  Pass: ", suite.pass, " Fail: ", suite.fails)
        write(repl("#", 48), "\n")
    }
end

#
# timer calculation
#
procedure bigtime(timer)
    secs := gettimeofday().sec - timer.sec
    usecs := gettimeofday().usec - timer.usec
    return secs * 1000000 + usecs
end

#
# usage failure
#
procedure testFailure(s)
    write(&errout, s)
end

#
# uval.icn, an eval function
#
# Author: Brian Tiffin
# Dedicated to the public domain
#
# Date: September 2016
# Modified: 2016-09-17/14:48-0400
#
$define base "/tmp/child-xyzzy"

link ximage

#
# try an evaluation
#
procedure uval(code)
    program := "# temporary file for unitest eval, purge at will\n_
        procedure main()\n" || code || "\nreturn\nend"
    return eval(program)
end

#
# try a generator
#
procedure uvalGenerator(code)
    program := "# temporary file for unitest eval, purge at will\n_
        procedure main()\n" || code || "\nend"
    return eval(program)
end

#
# eval, given string (either code or filename with isfile)
#
procedure eval(s, isfile)
    local f, codefile, code, coex, status, child, result

    if \isfile then {
        f := open(s, "r") | fail
        code ||:= every(!read(f))
    } else code := s

    # compile and load the code
    codefile := open(base || ".icn", "w") | fail
    write(codefile, code)
    close(codefile)

    status := system("unicon -s -o " || base  || " " ||
                     base || ".icn 2>/dev/null")

    # task can have io redirection here for stdout compares...
    if \status then coex := load(base)

    remove(base || ".icn")
    remove(base)
    return coex
end