diff options
-rw-r--r-- | examples/sml/COPYING | 11 | ||||
-rw-r--r-- | examples/sml/Makefile | 5 | ||||
-rw-r--r-- | examples/sml/checks.sig | 23 | ||||
-rw-r--r-- | examples/sml/checks.sml | 87 | ||||
-rw-r--r-- | examples/sml/helper.sig | 61 | ||||
-rw-r--r-- | examples/sml/helper.sml | 173 | ||||
-rw-r--r-- | examples/sml/main.sml | 25 | ||||
-rwxr-xr-x | examples/sml/run.sh | 23 | ||||
-rw-r--r-- | examples/sml/sources.cm | 11 | ||||
-rw-r--r-- | examples/sml/support/README | 1 | ||||
-rw-r--r-- | examples/sml/support/adder.sig | 5 | ||||
-rw-r--r-- | examples/sml/support/sources.cm | 2 | ||||
-rw-r--r-- | examples/sml/support/timer.sml | 63 | ||||
-rwxr-xr-x | examples/sml/test_checks.sh | 16 | ||||
-rw-r--r-- | examples/sml/test_handins/README | 5 | ||||
-rw-r--r-- | examples/sml/test_handins/bad.exp | 10 | ||||
-rw-r--r-- | examples/sml/test_handins/bad.tar | bin | 0 -> 10240 bytes | |||
-rw-r--r-- | examples/sml/test_handins/perfect.exp | 10 | ||||
-rw-r--r-- | examples/sml/test_handins/perfect.tar | bin | 0 -> 10240 bytes |
19 files changed, 531 insertions, 0 deletions
diff --git a/examples/sml/COPYING b/examples/sml/COPYING new file mode 100644 index 0000000..c8ca2c9 --- /dev/null +++ b/examples/sml/COPYING @@ -0,0 +1,11 @@ +Permission to use, copy, modify, and/or distribute this software for any +purpose with or without fee is hereby granted, provided that the above +copyright notice and this permission notice appear in all copies. + +THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH +REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND +FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, +INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM +LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR +OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR +PERFORMANCE OF THIS SOFTWARE. diff --git a/examples/sml/Makefile b/examples/sml/Makefile new file mode 100644 index 0000000..c6a5adb --- /dev/null +++ b/examples/sml/Makefile @@ -0,0 +1,5 @@ +autograde: + # h: follow links, i.e., so that we include the contents of the tutch symlink + tar chf ../autograde.tar --exclude=./Makefile --exclude=test_handins . + +.PHONY: autograde diff --git a/examples/sml/checks.sig b/examples/sml/checks.sig new file mode 100644 index 0000000..6b0453c --- /dev/null +++ b/examples/sml/checks.sig @@ -0,0 +1,23 @@ +(* Copyright (C) 2017 Ryan Kavanagh <rkavanagh@cs.cmu.edu> *) +(* Distributed under the ISC license, see COPYING for details. *) + +signature CHECKS = +sig + (* checks are either: *) + (* Check (name, f): *) + (* f : checks some property, and can catastrophically abort *) + (* or raise some exception if something is not satisfied. *) + (* Useful for sanity checks like: do all desired files *) + (* exist? *) + (* Problem (name, f): *) + (* name : must be the same name as the autolab problem *) + (* that is being graded. *) + (* f : returns an integer, which is the score awarded for *) + (* problem "name". *) + datatype checks = Check of string * (unit -> unit) + | Problem of string * (unit -> real) + + val checks : checks list + + val scoreboard : (string * real) list -> int list option +end diff --git a/examples/sml/checks.sml b/examples/sml/checks.sml new file mode 100644 index 0000000..d5b7262 --- /dev/null +++ b/examples/sml/checks.sml @@ -0,0 +1,87 @@ +(* Copyright (C) 2017-2018 Ryan Kavanagh <rkavanagh@cs.cmu.edu> *) +(* Distributed under the ISC license, see COPYING for details. *) + +(* This is a hypothetical assignment where students have to *) +(* implement addition. There are two Autolab problems testing *) +(* their implementation on "easy" and "hard" pairs of input. *) +(* The scoreboard just keeps track of how many bonuses problems *) +(* their implementation solves. *) +(* Because addition can be very lengthy, we timeout the execution *) +(* after a fixed amount of time. *) + +functor ChecksHelper (structure H : HELPER) : CHECKS where type checks = H.checks = +struct + +datatype checks = datatype H.checks + +(*****************************************************) +(********** CONFIGURE ME HERE *******) +(*****************************************************) + +structure Student : ADDER = Adder + +(* Run function f with arguments a with timeout of n seconds. *) +fun try n f a = Timeout.runWithTimeout (Time.fromSeconds n) f a + +(* test data is of the form *) +(* ("autolab exercise name", maxScore, [(input,expected),...]) *) +val testSums = [("easy", 4, [((1,1),2), ((1,2),3), ((2,2),4), ((3,5),8)]), + ("hard", 8, [((152,203),355), ((1212,2121),3333)])] + +(* Bonus problems that get used for score board *) +val bonusSums = [((10,~10),0)] +(* Pretty print problem input *) +fun inputToString (x,y) = (Int.toString x) ^ " + " ^ (Int.toString y) + +(* Compare student output to expected output with a timeout, and *) +(* compute the % of correct answers. *) +fun compare tests = + let fun c (input,expected) = + let val testStr = inputToString input in + case try 10 Student.add input of + (* No timeout *) + SOME b => if b = expected then + ( H.printLn ("Passed: " ^ testStr) + ; (1, 0)) + else + ( H.printLn ("Failed: " ^ testStr) + ; H.printLn (" Expected " + ^ (Int.toString expected) + ^ " but got " ^ (Int.toString b)) + ; (0, 1) ) + | NONE => ( H.printLn ("Timed out after 10s on " ^ testStr) + ; (0, 1)) + end + fun addp (a, b) (c, d) = (a + c, b + d) + val (same,diff) = List.foldl (fn (p,acc) => addp (c p) acc) + (0, 0) + tests + in real same / real (same + diff) end + +val checks = List.map (fn (name,max,tests) => + H.Problem (name, fn _ => real max * compare tests)) + testSums + +fun scoreboard score = + ( H.printLn "Checking bonuses..." + ; SOME [List.foldl + (fn ((p,b),acc) => + if try 2 Student.add p = SOME b then + ( H.printLn ("Got bonus " ^ (inputToString p)) + ; H.printLn ("Well done!") + ; acc + 1 + ) + else + ( H.printLn ("Failed to add bonus " ^ (inputToString p)) + ; H.printLn ("in under 2 seconds. Skipping.") + ; acc + ) + ) + 0 + bonusSums] ) + +(*****************************************************) +(********** END CONFIGURATION *******) +(*****************************************************) + +end diff --git a/examples/sml/helper.sig b/examples/sml/helper.sig new file mode 100644 index 0000000..82467d6 --- /dev/null +++ b/examples/sml/helper.sig @@ -0,0 +1,61 @@ +(* Copyright (C) 2017 Ryan Kavanagh <rkavanagh@cs.cmu.edu> *) +(* Distributed under the ISC license, see COPYING for details. *) + +signature HELPER = +sig + datatype checks = Check of string * (unit -> unit) + | Problem of string * (unit -> real) + + (* Path to the directory under which we can find a student's *) + (* submitted files. *) + val handinPath : string + + (* Takes in the name of a file submitted by a student *) + (* and joins it with handinPath. *) + val joinHandinPath : string -> string + + (* Removes handinPath from a path if it prefixes it. *) + val stripHandinPath : string -> string + + (* Takes in a list of filenames, and checks if those files *) + (* exist in the handinPath directory. *) + (* Aborts catastrophically if a file is missing. *) + val checkFilesExist : string list -> unit + + (* Uses ghostscript to check if the student submitted a valid *) + (* PDF (or an empty file in its place). Aborts catastrophically *) + (* if missing. *) + val checkPDF : string -> unit + + (* Runs a series of checks and then outputs a list of *) + (* (problem name, score) tuples *) + val runChecks : checks list -> (string * real) list + + (* Produces an AutoLab JSON score string from a scores list *) + (* and optional scoreboard *) + val scoresToString : (string * real) list * int list option -> string + + (* Puts a list of strings in a box for printing. *) + val stringsInBox : string list -> string list + + (* Prints a list of strings in a box. *) + val printInBox : string list -> unit + + (* Prints a string followed by newline. *) + val printLn : string -> unit + + (* printLns a list of strings, then the empty score, *) + (* then exits. Useful when you need to abort early. *) + val abortWithMessage : string list -> 'a + + (* Prints a command and then runs it, returning the exit status *) + val runCmd : string -> OS.Process.status + + (* Runs a command (with argument list) using Posix.Process.execp. *) + (* Return the program's output as a string, along with its exit status. *) + val execpOutput : string * string list -> string * Posix.Process.exit_status + + (* Takes a regex in awk format, and a string, and checks if *) + (* the regex matches the string *) + val matchesAwkRegex : string * string -> bool +end diff --git a/examples/sml/helper.sml b/examples/sml/helper.sml new file mode 100644 index 0000000..d20e96f --- /dev/null +++ b/examples/sml/helper.sml @@ -0,0 +1,173 @@ +(* Copyright (C) 2017 Ryan Kavanagh <rkavanagh@cs.cmu.edu> *) +(* Distributed under the ISC license, see COPYING for details. *) + +functor Helper (structure C : sig val handinPath : string end) + :> HELPER = +struct + +exception MissingFile of string + +datatype checks = Check of string * (unit -> unit) + | Problem of string * (unit -> real) + +val handinPath = C.handinPath + +fun printLn s = print (s ^ "\n") + +(* Puts strings in boxes... *) +fun stringsInBox strs = + let fun repeatChar c n = String.implode (List.tabulate (n, fn _ => c)) + val maxLength = List.foldl (fn (s,themax) => Int.max (String.size s, themax)) 0 strs + val edge = repeatChar #"#" (maxLength + 4) + in + edge :: (List.foldr (fn (s,thelist) => ("# " + ^ s + ^ (repeatChar #" " (maxLength - (String.size s))) + ^ " #") :: thelist) + [edge] + strs) + end + +(* Prints strings in boxes... *) +fun printInBox strs = List.app printLn (stringsInBox strs) + +(* Generates an AutoLab json score string *) +fun scoresToString (scores, scoreboard) = + let val scoreStrings = map (fn (problem, score) => "\"" ^ problem ^ "\": " ^ (Real.toString score)) scores + val scores = String.concatWith ", " scoreStrings + val scoreboard = case scoreboard + of SOME l => ", \"scoreboard\": [" ^ (String.concatWith ", " (map Int.toString l)) ^ "]" + | NONE => "" + in + "{\"scores\": {" ^ scores ^ "}" ^ scoreboard ^ "}" + end + +(* Aborts the program by printing strs, and gives an empty score. *) +fun abortWithMessage strs = + let val _ = List.app printLn strs + val _ = printLn (scoresToString ([],NONE)) + in + OS.Process.exit OS.Process.success + end + + +(* Reads the lines of a file into a list *) +(* Each string in the file will always be contain a newline (#"\n") at the end. *) +fun readLines filename = + let val inFile = TextIO.openIn filename + fun readlines ins = + case TextIO.inputLine ins + of SOME ln => ln :: readlines ins + | NONE => [] + val lines = readlines inFile + val _ = TextIO.closeIn inFile + in + lines + end + +(* Check if the file exists *) +fun checkFileExists (name : string) : unit = + if OS.FileSys.access (name, [OS.FileSys.A_READ]) + then () + else raise MissingFile name + +fun joinHandinPath file = + OS.Path.concat (handinPath, file) + +fun stripHandinPath path = + if String.isPrefix handinPath path then + String.extract (path, String.size handinPath + 1, NONE) + else + path + + +(* Takes in a list of filenames, and checks if those files *) +(* exist in the handinPath directory. *) +(* Exits catastrophically if a file is missing. *) +fun checkFilesExist filenames = + List.app (checkFileExists o joinHandinPath) filenames + handle MissingFile name => (abortWithMessage o stringsInBox) + [ "File " ^ (stripHandinPath name) ^ " missing." + , "Please make sure you included all required files and resubmit."] + +fun runCmd cmd = (printLn cmd; OS.Process.system cmd) + +(* Reads from fd in n byte chunks and treats it all as strings. *) +fun readAllFDAsString (fd, n) = + let val v = Posix.IO.readVec (fd, n) + in if Word8Vector.length v = 0 then + "" + else + (Byte.bytesToString v) ^ (readAllFDAsString (fd, n)) + end + +(* Runs a command c (command and argument list) using Posix.Process.execp. *) +(* Return the program's output as a string, along with its exit status. *) +fun execpOutput (c : string * string list) : string * Posix.Process.exit_status = + let val { infd = infd, outfd = outfd } = Posix.IO.pipe () + in case Posix.Process.fork () + of NONE => (* Child *) + (( Posix.IO.close infd + ; Posix.IO.dup2 { old = outfd, new = Posix.FileSys.stdout } + ; Posix.IO.dup2 { old = outfd, new = Posix.FileSys.stderr } + ; Posix.Process.execp c) + handle OS.SysErr (err, _) => + ( print ("Fatal error in child: " ^ err ^ "\n") + ; OS.Process.exit OS.Process.failure )) + | SOME pid => (* Parent *) + let val _ = Posix.IO.close outfd + val (_, status) = Posix.Process.waitpid (Posix.Process.W_CHILD pid, []) + val output = readAllFDAsString (infd, 100) + val _ = Posix.IO.close infd + in (output, status) end + end + + +(* Check if a submitted file is a valid PDF using ghostscript. *) +fun checkPDF pdf = + let val spdf = joinHandinPath pdf in + case ( runCmd ("gs -o/dev/null -sDEVICE=nullpage " ^ spdf) + , Posix.FileSys.ST.size (Posix.FileSys.stat spdf) ) + of (_,0) => let val _ = printInBox [ "Warning: The empty file " ^ pdf ^ " is not a valid PDF document." + , "Please make sure to resubmit with a valid PDF document in its place." ] + in () end + | (0,_) => () + | _ => (abortWithMessage o stringsInBox) + [ "The file " ^ pdf ^ " is not a valid PDF document." + , "Please resubmit with a valid PDF document (or an empty file) in its place." + , "If you are convinced you submitted a valid PDF, please contact the course staff." ] + end + +(* Runs all of the checks and grades all of the problems in "checks". *) +fun runChecks (checks : checks list) = + List.foldl (fn (cs,results) => + case cs + of (Check (n, c)) => let val _ = printLn ("\n\nRunning check " ^ n ^ "...") + val _ = c () + val _ = printLn " Success.\n" + in results end + | (Problem (n, c)) => let val _ = printLn ("\n\nChecking problem " ^ n ^ "...") + val res = c () + val _ = printLn (" Score: " ^ (Real.toString res) ^ ".\n") + in (n, res) :: results end) + [] + checks + + +(* Returns a score of zero for all problems. *) +(* Useful when you need to abort but still provide a score. *) +fun failAll (checks : checks list) = + List.foldr (fn (cs,results) => + case cs + of Problem (n, c) => (n, 0) :: results + | _ => results) + [] + checks + +structure RE = RegExpFn(structure P = AwkSyntax + structure E = ThompsonEngine) + +fun matchesAwkRegex (r, s) = + let val r = RE.find (RE.compileString r) + in Option.isSome (StringCvt.scanString r s) end +end diff --git a/examples/sml/main.sml b/examples/sml/main.sml new file mode 100644 index 0000000..95e5bb5 --- /dev/null +++ b/examples/sml/main.sml @@ -0,0 +1,25 @@ +(* Copyright (C) 2017 Ryan Kavanagh <rkavanagh@cs.cmu.edu> *) +(* Distributed under the ISC license, see COPYING for details. *) + +structure Main :> + sig + val main : (string * string list) -> OS.Process.status + end += +struct +structure H = Helper (structure C = struct val handinPath = "handin" end) +structure C = ChecksHelper(structure H = H) + +fun main _ = + let val scores = H.runChecks C.checks + val scoreboard = C.scoreboard scores + (* Make sure the scores are on the last line. *) + val _ = print "\n\n\n" + (* This below *must must must* be the last thing printed.. *) + val _ = H.printLn (H.scoresToString (scores, scoreboard)) + in OS.Process.success end + handle _ => (H.abortWithMessage o H.stringsInBox) + [ "Experienced uncaught exception!" + , "If you believe this to be in error, please contact your" + ^ " course staff." ] +end diff --git a/examples/sml/run.sh b/examples/sml/run.sh new file mode 100755 index 0000000..fcaea5d --- /dev/null +++ b/examples/sml/run.sh @@ -0,0 +1,23 @@ +#!/bin/sh + +abort () { + if [ "x$1" != "x" ]; then + echo "$1" + fi + printf "\n\n{\"scores\": {}}" + exit 0 +} + +[ -d handin ] || mkdir handin + +[ -f handin.tar ] || \ + abort "Submission is expected to be at handin.tar. This file does not exist!" + +tar -xf handin.tar -C handin || \ + abort "Failed to extract submission." + +ml-build sources.cm Main.main grader || \ + abort "Failed to compile autograder. Please contact course staff." + +sml @SMLload grader.* || \ + abort "SML autograder exited with error. Please contact course staff." diff --git a/examples/sml/sources.cm b/examples/sml/sources.cm new file mode 100644 index 0000000..1a8ca66 --- /dev/null +++ b/examples/sml/sources.cm @@ -0,0 +1,11 @@ +Group is + $/basis.cm + $/regexp-lib.cm + handin/adder.sml (* the student submission *) + support/adder.sig (* the ADDER signature *) + support/timer.sml + helper.sig (* the HELPER signature *) + helper.sml (* the Helper module *) + checks.sig (* the CHECKS signature *) + checks.sml (* the ChecksHelper functor *) + main.sml (* the big cheese *) diff --git a/examples/sml/support/README b/examples/sml/support/README new file mode 100644 index 0000000..8c31e1a --- /dev/null +++ b/examples/sml/support/README @@ -0,0 +1 @@ +Put any support files here. diff --git a/examples/sml/support/adder.sig b/examples/sml/support/adder.sig new file mode 100644 index 0000000..4203823 --- /dev/null +++ b/examples/sml/support/adder.sig @@ -0,0 +1,5 @@ +(* Your task is to implement this. *) +signature ADDER = +sig + val add : (int * int) -> int +end diff --git a/examples/sml/support/sources.cm b/examples/sml/support/sources.cm new file mode 100644 index 0000000..fad8872 --- /dev/null +++ b/examples/sml/support/sources.cm @@ -0,0 +1,2 @@ +(* Add any extra support SML files here *) +Group is diff --git a/examples/sml/support/timer.sml b/examples/sml/support/timer.sml new file mode 100644 index 0000000..4ea8663 --- /dev/null +++ b/examples/sml/support/timer.sml @@ -0,0 +1,63 @@ +(* From: https://github.com/msullivan/sml-util *) +(* Copyright (c) 2011-2015 Michael J. Sullivan *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a copy *) +(* of this software and associated documentation files (the "Software"), to deal *) +(* in the Software without restriction, including without limitation the rights *) +(* to use, copy, modify, merge, publish, distribute, sublicense, and/or sell *) +(* copies of the Software, and to permit persons to whom the Software is *) +(* furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included in *) +(* all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR *) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE *) +(* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER *) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, *) +(* OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN *) +(* THE SOFTWARE. *) + + +signature TIMEOUT = +sig + exception Timeout + + (* Run a function with a timeout. *) + val runWithTimeout : Time.time -> ('a -> 'b) -> 'a -> 'b option + + (* Run a function with a timeout, raising Timeout if it triggers *) + val runWithTimeoutExn : Time.time -> ('a -> 'b) -> 'a -> 'b + +end + +structure Timeout :> TIMEOUT = +struct + exception Timeout + + fun finally f final = + f () before ignore (final ()) + handle e => (final (); raise e) + + fun runWithTimeout t f x = + let val timer = SMLofNJ.IntervalTimer.setIntTimer + fun cleanup () = + (timer NONE; + Signals.setHandler (Signals.sigALRM, Signals.IGNORE); ()) + + val ret = ref NONE + fun doit k = + let fun handler _ = k + val _ = Signals.setHandler (Signals.sigALRM, + Signals.HANDLER handler) + val () = timer (SOME t) + in ret := SOME (f x) end + val () = finally (fn () => SMLofNJ.Cont.callcc doit) cleanup + in !ret end + + fun runWithTimeoutExn t f x = + case runWithTimeout t f x + of SOME x => x + | NONE => raise Timeout +end diff --git a/examples/sml/test_checks.sh b/examples/sml/test_checks.sh new file mode 100755 index 0000000..975ea4c --- /dev/null +++ b/examples/sml/test_checks.sh @@ -0,0 +1,16 @@ +#!/bin/sh + +make -s autograde + +for f in test_handins/*.tar; do + base=`basename -s .tar ${f}` + tmp=`mktemp -d` + cp ../autograde.tar ${tmp} + cp test_handins/${base}.tar ${tmp}/handin.tar + cp ../autograde-Makefile ${tmp} + echo "\e[41m!!!!!!! Last 10 output lines for test ${base}:\e[0m" + (cd ${tmp}; make -s -f autograde-Makefile | tail -n 10) + echo "\e[42m!!!!!!! Expected result:\e[0m" + cat test_handins/${base}.exp + rm -fr ${tmp} +done diff --git a/examples/sml/test_handins/README b/examples/sml/test_handins/README new file mode 100644 index 0000000..b43561b --- /dev/null +++ b/examples/sml/test_handins/README @@ -0,0 +1,5 @@ +To test your checks.sml, place sample submissions in this directory +according to the following format: + + somename.tar : the submission you want to test + somename.exp : the expected json score diff --git a/examples/sml/test_handins/bad.exp b/examples/sml/test_handins/bad.exp new file mode 100644 index 0000000..7002bce --- /dev/null +++ b/examples/sml/test_handins/bad.exp @@ -0,0 +1,10 @@ + Expected 3333 but got 12072 + Score: 0.0. + +Checking bonuses... +Failed to add bonus 10 + ~10 +in under 2 seconds. Skipping. + + + +{"scores": {"hard": 0.0, "easy": 0.0}, "scoreboard": [0]} diff --git a/examples/sml/test_handins/bad.tar b/examples/sml/test_handins/bad.tar Binary files differnew file mode 100644 index 0000000..46e0343 --- /dev/null +++ b/examples/sml/test_handins/bad.tar diff --git a/examples/sml/test_handins/perfect.exp b/examples/sml/test_handins/perfect.exp new file mode 100644 index 0000000..fbc13ae --- /dev/null +++ b/examples/sml/test_handins/perfect.exp @@ -0,0 +1,10 @@ +Passed: 1212 + 2121 + Score: 8.0. + +Checking bonuses... +Got bonus 10 + ~10 +Well done! + + + +{"scores": {"hard": 8.0, "easy": 4.0}, "scoreboard": [1]} diff --git a/examples/sml/test_handins/perfect.tar b/examples/sml/test_handins/perfect.tar Binary files differnew file mode 100644 index 0000000..2fa75d0 --- /dev/null +++ b/examples/sml/test_handins/perfect.tar |