diff --git a/meson.build b/meson.build index d8915246..e4919b9f 100644 --- a/meson.build +++ b/meson.build @@ -216,7 +216,8 @@ test_files = [ 'test/suite4.janet', 'test/suite5.janet', 'test/suite6.janet', - 'test/suite7.janet' + 'test/suite7.janet', + 'test/suite8.janet' ] foreach t : test_files test(t, janet_nativeclient, args : files([t]), workdir : meson.current_source_dir()) diff --git a/test/suite8.janet b/test/suite8.janet new file mode 100644 index 00000000..a43777e9 --- /dev/null +++ b/test/suite8.janet @@ -0,0 +1,73 @@ +# Copyright (c) 2020 Calvin Rose & contributors +# +# 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. + +(import ./helper :prefix "" :exit true) +(start-suite 8) + +### +### Compiling brainfuck to Janet. +### + +(def- bf-peg + "Peg for compiling brainfuck into a Janet source ast." + (peg/compile + ~{:+ (/ '(some "+") ,(fn [x] ~(+= (DATA POS) ,(length x)))) + :- (/ '(some "-") ,(fn [x] ~(-= (DATA POS) ,(length x)))) + :> (/ '(some ">") ,(fn [x] ~(+= POS ,(length x)))) + :< (/ '(some "<") ,(fn [x] ~(-= POS ,(length x)))) + :. (* "." (constant (prinf "%c" (get DATA POS)))) + :loop (/ (* "[" :main "]") ,(fn [& captures] + ~(while (not= (get DATA POS) 0) + ,;captures))) + :main (any (+ :s :loop :+ :- :> :< :.)) })) + +(defn bf + "Run brainfuck." + [text] + (eval + ~(let [DATA (array/new-filled 100 0)] + (var POS 50) + ,;(peg/match bf-peg text)))) + +(defn test-bf + "Test some bf for expected output." + [input output] + (def b @"") + (with-dyns [:out b] + (bf input)) + (assert (= (string output) (string b)) + (string "bf input '" + input + "' failed, expected " + (describe output) + ", got " + (describe (string b)) + "."))) + +(test-bf "++++++++[>++++[>++>+++>+++>+<<<<-]>+>+>->>+[<]<-]>>.>---.+++++++..+++.>>.<-.<.+++.------.--------.>>+.>++." "Hello World!\n") + +(test-bf ">++++++++[-<+++++++++>]<.>>+>-[+]++>++>+++[>[->+++<<+++>]<<]>-----.>-> ++++..+++.>-.<<+[>[+>+]>>]<--------------.>>.+++.------.--------.>+.>+." + "Hello World!\n") + +(test-bf "+[+[<<<+>>>>]+<-<-<<<+<++]<<.<++.<++..+++.<<++.<---.>>.>.+++.------.>-.>>--." + "Hello, World!") + +(end-suite)