├── .gitignore ├── LICENSE.md ├── README.md ├── main.sh ├── origTransformHeader.rkt ├── tests ├── testBoolLiteral.rkt ├── testCallNonAtomic.rkt ├── testDataStructurePoint.rkt ├── testDataStructures.rkt ├── testDefineLambda.rkt ├── testDefineSimple.rkt ├── testFactorial.rkt ├── testIdentifierLiteral.rkt ├── testIfAtomic.rkt ├── testIfNestedComplex.rkt ├── testIfNonAtomic.rkt ├── testIfSimple.rkt ├── testIntLiteral.rkt ├── testLambdasNested.rkt ├── testShiftNested.rkt ├── testShiftNestedComplex.rkt ├── testShiftReset.rkt ├── testTryCatch.rkt ├── testTryCatchSimple.rkt ├── testTryNestedSimple.rkt └── testTryRethrow.rkt └── transpiler.rkt /.gitignore: -------------------------------------------------------------------------------- 1 | /tmp -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | # The Don't-be-a-Dick license 2 | 3 | The terms of use for this testing suite are very simple. 4 | 5 | If you want to use this testing suite, you must: 6 | * Contribute at least 2 test cases, by way of putting in a pull request. 7 | * Tell your friends about it, tell them to add test cases! 8 | 9 | A.k.a Don't be a dick. 10 | 11 | Thanks. 12 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # CSC324 Testing Suite 2 | 3 | This is a crude testing suite for CSC324-A2 (Chups!) 4 | 5 | ## Usage 6 | 7 | Run the following command in your repository inside your folder containing `Chups.hs` and `ChupsTypes.hs`: 8 | 9 | ```sh 10 | git submodule add https://github.com/EDToaster/CSC324-A2-TestingSuite testing 11 | ``` 12 | 13 | ### Running the Test Suite 14 | 15 | ```sh 16 | cd testing 17 | chmod +x main.sh 18 | ./main.sh 19 | ``` 20 | 21 | ### Adding a New Test 22 | 23 | All tests reside in `./tests`, add a new file here for your new test. 24 | 25 | Note: You need to use the `cps` transformed versions of the functions `cps:*, cps:+, etc`. Since there is no `cps:-` or `cps:/`, arithmetic expressions are fairly limited (unless you implement them yourself). The testing suite does not guarantee that your solution to A2 is correct, even if it passes all of the test cases! 26 | 27 | Note note: The return value of the test cases can be anything. We aren't checking for the return values ... rather we are checking that, after running through the transformation, the output stays the same! 28 | 29 | ## Implementation 30 | 31 | This test suite works as follows: 32 | 33 | * For each input program in `tests` folder 34 | * Transpile this input program to haskell-data format 35 | * Transpile haskell-data format back to racket using cpsTransform 36 | * Evaluate both the input Chups program and the output Racket program 37 | * If the two outputs are equivalent, pass the test case 38 | * If the two outputs are different, fail the test case 39 | -------------------------------------------------------------------------------- /main.sh: -------------------------------------------------------------------------------- 1 | #! /bin/bash 2 | 3 | rm -rf ./tmp 4 | mkdir ./tmp 5 | 6 | FILES=`ls ./tests` 7 | 8 | LENGTH=`echo $FILES | wc -w` 9 | PASSED="0" 10 | FAILED="0" 11 | 12 | ORIG_HEADER=`cat ./origTransformHeader.rkt` 13 | 14 | echo "Running $LENGTH tests ..." 15 | 16 | for file in $FILES; do 17 | PROGRAM=`tr -cd "[:print:]\n" < "./tests/$file"` 18 | ORIG="./tmp/$file.o.rkt" 19 | TRAN="./tmp/$file.t.rkt" 20 | 21 | # headers for the language 22 | echo "#!/usr/bin/racket" > "$ORIG" 23 | echo "#lang racket" >> "$ORIG" 24 | 25 | # both files need this header 26 | cat "$ORIG" > "$TRAN" 27 | 28 | # original racket header and program -- needed for evaulation of the original program input 29 | printf "$ORIG_HEADER\n$PROGRAM" >> "$ORIG" 30 | 31 | # transpile to haskell syntax 32 | HASKELL=`racket transpiler.rkt "$PROGRAM"` 33 | # evaulate the haskell version in ghci, to get cpsTransformed racket 34 | echo "import Control.Monad 35 | import System.IO 36 | (forM_ [stdout, stderr] . flip hPutStrLn) $ show $ cpsTransformProgS $ (Prog $HASKELL)" | ghci -i.. Chups 2>> "$TRAN" 1>/dev/null 37 | 38 | ORIG_RESULT=`racket "$ORIG"` 39 | TRANSFORMED_RESULT=`racket "$TRAN"` 40 | 41 | if [ "$ORIG_RESULT" == "$TRANSFORMED_RESULT" ]; then 42 | echo "+++ Passed: $file" 43 | ((PASSED++)) 44 | else 45 | echo "+++ Failed: $file" 46 | echo "======= Expected:" 47 | echo "$ORIG_RESULT" 48 | echo "======= Found:" 49 | echo "$TRANSFORMED_RESULT" 50 | ((FAILED++)) 51 | fi 52 | done 53 | 54 | echo "Passed $PASSED out of $LENGTH tests" 55 | if [ "$FAILED" != "0" ]; then 56 | echo "($FAILED tests failed)" 57 | fi -------------------------------------------------------------------------------- /origTransformHeader.rkt: -------------------------------------------------------------------------------- 1 | (require racket/control) 2 | (define (cps:+ . args) (apply + args)) 3 | (define (cps:* . args) (apply * args)) 4 | (define (cps:equal? . args) (apply equal? args)) 5 | (define (is-exception-of? msg) (lambda (error) (equal? msg error))) 6 | (define-syntax try 7 | (syntax-rules () 8 | ((_ expr msg handler) 9 | (with-handlers ([(is-exception-of? msg) (lambda (err) handler)]) expr)))) -------------------------------------------------------------------------------- /tests/testBoolLiteral.rkt: -------------------------------------------------------------------------------- 1 | ; Tests a simple boolean. Easy peasy 2 | #f -------------------------------------------------------------------------------- /tests/testCallNonAtomic.rkt: -------------------------------------------------------------------------------- 1 | #| 2 | Tests that the continuations of a non-atomic function is 3 | generated correctly 4 | |# 5 | ((lambda (a b c) (cps:+ a b c)) (cps:* 1 2) (cps:+ 3 5) (cps:* 1 2 3 5 1 1)) -------------------------------------------------------------------------------- /tests/testDataStructurePoint.rkt: -------------------------------------------------------------------------------- 1 | #| 2 | Using structs! 3 | Defines points where: 4 | 0: x coord 5 | 1: y coord 6 | 2: returns the square euclidean distance from (0,0) 7 | |# 8 | (define Point (lambda (x y) (lambda (msg) ( 9 | if (cps:equal? msg 0) x ( 10 | if (cps:equal? msg 1) y ( 11 | if (cps:equal? msg 2) (cps:+ (cps:* x x) (cps:* y y)) 3 12 | )))))) 13 | 14 | (define p1 (Point 2 2)) 15 | (p1 2) -------------------------------------------------------------------------------- /tests/testDataStructures.rkt: -------------------------------------------------------------------------------- 1 | #| 2 | Custom list data structures using many pairs ... 3 | calculate custom foldl function 4 | |# 5 | (define first (lambda (p) (p #t))) 6 | (define rest (lambda (p) (p #f))) 7 | (define cons (lambda (a b) (lambda (i) (if i a b)))) 8 | (define foldl (lambda (proc init lst) (if (cps:equal? null lst) init (foldl proc (proc (first lst) init) (rest lst))))) 9 | (define map (lambda (proc lst) (if (cps:equal? null lst) null (cons (proc (first lst)) (map proc (rest lst)))))) 10 | (define list-1-10 (cons 1 (cons 2 (cons 3 (cons 4 (cons 5 (cons 6 (cons 7 (cons 8 (cons 9 (cons 10 null))))))))))) 11 | (define add-1 (lambda (n) (cps:+ 1 n))) 12 | (foldl cps:+ 0 (map add-1 list-1-10)) -------------------------------------------------------------------------------- /tests/testDefineLambda.rkt: -------------------------------------------------------------------------------- 1 | #| 2 | Test assigning lambdas to functions, mainly testing that lambda 3 | transformations are correct. 4 | |# 5 | (define f (lambda (a b) (cps:+ a b))) 6 | 7 | #| 8 | Testing that values can be assigned to identifiers, 9 | and that the values are passed through the identity continuation 10 | |# 11 | (define x 1) 12 | (define y 2) 13 | (f x y) -------------------------------------------------------------------------------- /tests/testDefineSimple.rkt: -------------------------------------------------------------------------------- 1 | ; Simple define 2 | (define x 1) 3 | (cps:+ x 1) -------------------------------------------------------------------------------- /tests/testFactorial.rkt: -------------------------------------------------------------------------------- 1 | #| 2 | Testing the transpiler by calculating the factorial of 100 3 | Just testing that the cpsTransformation of function calls 4 | are sematically correct. 5 | |# 6 | 7 | (define fac-helper (lambda (n c acc) 8 | (if (cps:equal? n c) (cps:* acc c) (fac-helper n (cps:+ c 1) (cps:* acc c))))) 9 | ; we have to use an accumulator for fac because there is no "-" function 10 | (define fac (lambda (n) (fac-helper n 1 1))) 11 | (cps:equal? 12 | (fac 100) 13 | 93326215443944152681699238856266700490715968264381621468592963895217599993229915608941463976156518286253697920827223758251185210916864000000000000000000000000) -------------------------------------------------------------------------------- /tests/testIdentifierLiteral.rkt: -------------------------------------------------------------------------------- 1 | (define k 1) 2 | k -------------------------------------------------------------------------------- /tests/testIfAtomic.rkt: -------------------------------------------------------------------------------- 1 | (if #t #t #f) -------------------------------------------------------------------------------- /tests/testIfNestedComplex.rkt: -------------------------------------------------------------------------------- 1 | #| 2 | Basic branching logic. 3 | |# 4 | (define f (lambda (a) a)) 5 | (if 6 | (f #t) 7 | (if (f #f) (f 1) (f 2)) 8 | (if (f #f) (f 3) (f 4))) -------------------------------------------------------------------------------- /tests/testIfNonAtomic.rkt: -------------------------------------------------------------------------------- 1 | (if (cps:equal? (cps:+ 10 10) (cps:+ 20 20)) (cps:+ (cps:* 10 2) (cps:* 10 3)) (cps:* (cps:+ 1 2) (cps:+ 3 4))) -------------------------------------------------------------------------------- /tests/testIfSimple.rkt: -------------------------------------------------------------------------------- 1 | (define x (cps:+ 1 2)) 2 | (if x #t #f) -------------------------------------------------------------------------------- /tests/testIntLiteral.rkt: -------------------------------------------------------------------------------- 1 | ; Just a lonely integer :( 2 | 1 -------------------------------------------------------------------------------- /tests/testLambdasNested.rkt: -------------------------------------------------------------------------------- 1 | #| 2 | Nested lambdas, again checking the continuations 3 | |# 4 | ((lambda (x) ( 5 | (lambda (y) (cps:+ y x)) 12)) 13) -------------------------------------------------------------------------------- /tests/testShiftNested.rkt: -------------------------------------------------------------------------------- 1 | ; Simple Nested shift 2 | (reset (cps:* 9 (shift k (k (k 10))))) -------------------------------------------------------------------------------- /tests/testShiftNestedComplex.rkt: -------------------------------------------------------------------------------- 1 | #| 2 | Testing shift/reset semantics when k is nested 3 | |# 4 | (reset (cps:* 10 (shift k1 (k1 (k1 (reset (cps:+ 19 (shift _k (_k (_k (k1 10))))))))))) -------------------------------------------------------------------------------- /tests/testShiftReset.rkt: -------------------------------------------------------------------------------- 1 | #| 2 | Testing semantic correctness of shift and reset ... 3 | should have the same behaviour as racket's shift 4 | and reset, but without using those identifiers! 5 | |# 6 | (cps:* 11 (reset (cps:* 10 (shift k (k (reset (shift k (k 10)))))))) -------------------------------------------------------------------------------- /tests/testTryCatch.rkt: -------------------------------------------------------------------------------- 1 | #| 2 | Try-catching errors. 3 | |# 4 | 5 | (define infinity 42) 6 | (define no-zero (lambda (n) (if (cps:equal? n 0) (raise "what are you doing") n))) 7 | (try (no-zero 0) "what are you doing" 42) -------------------------------------------------------------------------------- /tests/testTryCatchSimple.rkt: -------------------------------------------------------------------------------- 1 | ; Simple try catch, should return 42 2 | (try (raise "err") "err" 42) -------------------------------------------------------------------------------- /tests/testTryNestedSimple.rkt: -------------------------------------------------------------------------------- 1 | (try (try (raise "err1") "err2" 42) "err1" 69) -------------------------------------------------------------------------------- /tests/testTryRethrow.rkt: -------------------------------------------------------------------------------- 1 | (try (try (raise "err1") "err1" (raise "err2")) "err2" "Found error, exit") -------------------------------------------------------------------------------- /transpiler.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | #| 4 | Converts a symbol into a quoted string (useful for lambda parameter names) 5 | |# 6 | (define (ident->string datum) (format "\"~a\"" (symbol->string datum))) 7 | 8 | #| 9 | Converts a list of symbols into a list of quoted strings (usefule for 10 | multiple lambda parameter names) 11 | |# 12 | (define (string-lst lst) (format "[~a]" (string-join (map ident->string lst) ", "))) 13 | 14 | #| 15 | Converts a list of Chups expressions into a list of haskell data expressions 16 | |# 17 | (define (expr-lst lst) (format "[~a]" (string-join (map transpile lst) ", "))) 18 | 19 | #| 20 | Transpiles a single Chups expression into a haskell data expression string 21 | |# 22 | (define (transpile datum) 23 | (match datum 24 | [(? integer?) (format "(IntLiteral ~a)" datum)] 25 | [(? boolean?) (format "(BoolLiteral ~a)" (if datum "True" "False"))] 26 | [(? symbol?) (format "(Identifier ~a)" (ident->string datum))] 27 | [(? string?) (format "(Error \"~a\")" datum)] 28 | [(list 'define id expr) (format "(Binding ~a ~a)" (ident->string id) (transpile expr))] 29 | [(list 'lambda params expr) (format "(Lambda ~a ~a)" (string-lst params) (transpile expr))] 30 | [(list 'if condExpr then else) (format "(If ~a ~a ~a)" (transpile condExpr) (transpile then) (transpile else))] 31 | [(list 'shift ident expr) (format "(Shift ~a ~a)" (ident->string ident) (transpile expr))] 32 | [(list 'reset expr) (format "(Reset ~a)" (transpile expr))] 33 | [(list 'raise error) (format "(Raise ~a)" (transpile error))] 34 | [(list 'try expr msg handler) (format "(Try ~a \"~a\" ~a)" (transpile expr) msg (transpile handler))] 35 | [(list func params ...) (format "(Call ~a ~a)" (transpile func) (expr-lst params))] 36 | )) 37 | 38 | #| 39 | Reads datums from to-read into a list of datums 40 | |# 41 | (define (read-to-lst to-read) 42 | (match (read to-read) 43 | [(? eof-object?) null] 44 | [read-datum (cons read-datum (read-to-lst to-read))]) 45 | ) 46 | 47 | (define racket-prog (vector-ref (current-command-line-arguments) 0)) 48 | 49 | #| 50 | Outputs the haskell-strings for input into the haskell transformation script 51 | |# 52 | (displayln 53 | (match 54 | (map transpile (call-with-input-string racket-prog read-to-lst)) 55 | [(list bindings ... expr) (format "[~a] ~a" (string-join bindings ", ") expr)])) 56 | --------------------------------------------------------------------------------