diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..8bc0a8a --- /dev/null +++ b/.gitignore @@ -0,0 +1,3 @@ +DEBUG +OUTPUT +referenceSolution.scm diff --git a/genericTester.scm b/genericTester.scm new file mode 100644 index 0000000..239a729 --- /dev/null +++ b/genericTester.scm @@ -0,0 +1,53 @@ +; If you found this file on Mimir and would like to update it, please submit +; a pull request to: +; https://github.uconn.edu/Brandon/CSE1729-Mimir-Testing-Scripts + +(define (testEntry) + (define student-answers-file (read (current-input-port))) + (load "utilities.scm") + (define test-function (read (current-input-port))) + (define test-arguments (read (current-input-port))) + (define test-output-transform (read (current-input-port))) + ; test-assertion should be a lambda we can pass student-out and reference-out + ; to. Ex: "(lambda (student reference) (< (abs (- student reference)) 0.0001)) + (define test-assertion (read (current-input-port))) + + (if (eq? test-output-transform "") + (set! test-output-transform (lambda (x) x)) + (set! test-output-transform (eval test-output-transform (interaction-environment)))) + + ; (display "Testing: (apply " (current-error-port)) + ; (display test-function (current-error-port)) + ; (display " '" (current-error-port)) + ; (display (eval test-arguments (interaction-environment)) (current-error-port)) + ; (display ")\n" (current-error-port)) + + ; Load student solution and grab their answer + (load student-answers-file) + (define student-out + (test-output-transform + (apply (eval test-function (interaction-environment)) + (eval test-arguments (interaction-environment))))) + + (display "Your output was: " (current-error-port)) + (display student-out (current-error-port)) + (newline (current-error-port)) + + ; Load our solution and grab our answer. + (load "referenceSolution.scm") + (define reference-out + (test-output-transform + (apply (eval test-function (interaction-environment)) + (eval test-arguments (interaction-environment))))) + + ; (display "The solution was: " (current-error-port)) + ; (display reference-out (current-error-port)) + ; (newline (current-error-port)) + + ; Ensure only #t or #f is the last line. This may not be the case if there + ; were calls to the display function in the student code. + (newline) + (display ((eval test-assertion (interaction-environment)) student-out reference-out)) + (newline)) + +(testEntry) diff --git a/genericTester.sh b/genericTester.sh new file mode 100755 index 0000000..9707f20 --- /dev/null +++ b/genericTester.sh @@ -0,0 +1,21 @@ +#!/bin/bash + +testOutputTransform=${testOutputTransform:-(lambda (x) x)} + +# Get first file with .rkt extension. +studentAnswersFile="$(ls | grep ".rkt" | head -n 1)" +stdinToGenericTester=" + \"$studentAnswersFile\"\n + $testFunction\n + (list $testArguments)\n + $testOutputTransform\n + (lambda (student reference) $testAssertion)\n" +RESULT=`echo -e $stdinToGenericTester | plt-r5rs genericTester.scm 2>> DEBUG` +# Treat the last line of the output as a fake exit status +EXITSTATUS=`echo "$RESULT" | tail -n 1` + +if [ "$EXITSTATUS" = "#t" ] ; then + echo "true" > OUTPUT +else + echo "false" > OUTPUT +fi diff --git a/utilities.scm b/utilities.scm new file mode 100644 index 0000000..f15e715 --- /dev/null +++ b/utilities.scm @@ -0,0 +1,44 @@ +(define (ref-bool-equal? a b) + ; tests whether a and b have same truth value + ; double negation forces true thing to be #t + ; useful for boolean functions + (not (not (or (and a b)(and (not a)(not b)))))) + +(define (ref-approx-=? a b tol) + ; tests whether a is within tol of b + ; a, b, and tol are numbers + ; useful for floats + (< (abs (- a b)) tol)) + +(define (ref-general-equal? x y) ;; works for numbers, strings, symbols, lists + (cond ((eq? x y) #t) + ((and (number? x)(number? y)) + (= x y)) + ((and (string? x)(string? y)) + (string=? x y)) + ((and (pair? x)(pair? y)) + (and (ref-general-equal? (car x)(car y)) + (ref-general-equal? (cdr x)(cdr y)))) + (else + #f))) + +(define (ref-general-member? x y) + (cond ((null? y) #f) + ((ref-general-equal? x (car y)) + #t) + (else + (ref-general-member? x (cdr y))))) + +(define (ref-remove-one x lst) + (cond ((null? lst) lst) + ((ref-general-equal? x (car lst)) + (cdr lst)) + (else + (cons (car lst)(ref-remove-one x (cdr lst)))))) + +(define (ref-permutation? x y) + (cond ((null? x)(null? y)) + ((null? y) #f) + ((ref-general-member? (car x) y) + (ref-permutation? (cdr x)(ref-remove-one (car x) y))) + (else #f)))