From 4e0860223fa33dfdd78e480b39c62d89d3011534 Mon Sep 17 00:00:00 2001
From: Brandon Cheng <brandon.cheng@uconn.edu>
Date: Thu, 29 Nov 2018 17:43:42 -0500
Subject: [PATCH] Initial commit

---
 .gitignore        |  3 +++
 genericTester.scm | 53 +++++++++++++++++++++++++++++++++++++++++++++++
 genericTester.sh  | 21 +++++++++++++++++++
 utilities.scm     | 44 +++++++++++++++++++++++++++++++++++++++
 4 files changed, 121 insertions(+)
 create mode 100644 .gitignore
 create mode 100644 genericTester.scm
 create mode 100755 genericTester.sh
 create mode 100644 utilities.scm

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)))