Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
Initial commit
  • Loading branch information
Brandon committed Nov 29, 2018
0 parents commit 4e08602
Show file tree
Hide file tree
Showing 4 changed files with 121 additions and 0 deletions.
3 changes: 3 additions & 0 deletions .gitignore
@@ -0,0 +1,3 @@
DEBUG
OUTPUT
referenceSolution.scm
53 changes: 53 additions & 0 deletions 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)
21 changes: 21 additions & 0 deletions 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
44 changes: 44 additions & 0 deletions 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)))

0 comments on commit 4e08602

Please sign in to comment.