bus-scheme 0.7.5 → 0.7.6

data/test/test_list_functions.scm

@@ -0,0 +1,11 @@
+;; Test list functions defined in list.scm
+
+(assert-equal (list 1 2) (append (list 1) (list 2)))
+
+(assert-equal (quote (1 2 3 4)) (append (quote ()) (quote (1 2 3 4))))
+(assert-equal (quote (1 2 3 4)) (append (quote (1 )) (quote (2 3 4))))
+(assert-equal (quote (1 2 3 4)) (append (quote (1 2 )) (quote (3 4))))
+(assert-equal (quote (1 2 3 4)) (append (quote (1 2 3 )) (quote (4))))
+(assert-equal (quote (1 2 3 4)) (append (quote (1 2 3 4)) (quote ())))
+
+(assert-equal (list 1 2 3) (reverse (list 3 2 1)))

data/test/test_parser.rb

@@ -6,7 +6,7 @@ class BusSchemeParserTest < Test::Unit::TestCase
     string = "(+ 2 2)"
     assert_equal :'(', BusScheme.pop_token(string)
 
-    assert_equal :'+', BusScheme.pop_token(string)
+    assert_equal :'+'.sym, BusScheme.pop_token(string)
     assert_equal 2, BusScheme.pop_token(string)
     assert_equal 2, BusScheme.pop_token(string)
     assert_equal :")", BusScheme.pop_token(string)
@@ -17,9 +17,9 @@ class BusSchemeParserTest < Test::Unit::TestCase
   end
 
   def test_tokenize
-    assert_equal [:'(', :'+', 2, 2, :')'], BusScheme.tokenize("(+ 2 2)")
-    assert_equal [:'(', :'+', 2, :'(', :'+', 22, 2, :')', :')'], BusScheme.tokenize("(+ 2 (+ 22 2))")
-    assert_equal [:'(', :plus, 2, 2, :')'], BusScheme.tokenize('(plus 2 2)')
+    assert_equal [:'(', :'+'.sym, 2, 2, :')'], BusScheme.tokenize("(+ 2 2)")
+    assert_equal [:'(', :'+'.sym, 2, :'(', :'+'.sym, 22, 2, :')', :')'], BusScheme.tokenize("(+ 2 (+ 22 2))")
+    assert_equal [:'(', :plus.sym, 2, 2, :')'], BusScheme.tokenize('(plus 2 2)')
   end
 
   def test_parse_numbers
@@ -31,35 +31,41 @@ class BusSchemeParserTest < Test::Unit::TestCase
   end
 
   def test_parses_two_strings
-    assert_parses_to "(concat \"hello\" \"world\")", [:concat, "hello", "world"]
+    assert_parses_to "(concat \"hello\" \"world\")", [:concat.sym, "hello", "world"]
   end
 
   def test_parse_list_of_numbers
     assert_parses_to "(2 2)", [2, 2]
   end
+  
+  def test_parse_dotted_cons
+    assert_parses_to "(22 . 11)", [:cons.sym, 22, 11]
+    assert_parses_to "((+ 2 2) . 11)", [:cons.sym, [:+.sym, 2, 2], 11]
+    assert_parses_to "(11 . (+ 2 2))", [:cons.sym, 11, [:+.sym, 2, 2]]
+  end
 
   def test_parse_list_of_atoms
-    assert_parses_to "(+ 2 2)", [:+, 2, 2]
+    assert_parses_to "(+ 2 2)", [:+.sym, 2, 2]
   end
 
   def test_parse_list_of_atoms_with_string
-    assert_parses_to "(+ 2 \"two\")", [:+, 2, "two"]
+    assert_parses_to "(+ 2 \"two\")", [:+.sym, 2, "two"]
   end
 
   def test_parse_list_of_nested_sexprs
-    assert_parses_to "(+ 2 (+ 2))", [:+, 2, [:+, 2]]
+    assert_parses_to "(+ 2 (+ 2))", [:+.sym, 2, [:+.sym, 2]]
   end
 
   def test_parse_list_of_deeply_nested_sexprs
-    assert_parses_to "(+ 2 (+ 2 (+ 2 2)))", [:+, 2, [:+, 2, [:+, 2, 2]]]
+    assert_parses_to "(+ 2 (+ 2 (+ 2 2)))", [:+.sym, 2, [:+.sym, 2, [:+.sym, 2, 2]]]
   end
 
   def test_parse_two_consecutive_parens_simple
-    assert_parses_to "(let ((foo 2)))", [:let, [[:foo, 2]]]
+    assert_parses_to "(let ((foo 2)))", [:let.sym, [[:foo.sym, 2]]]
   end
 
   def test_parse_two_consecutive_parens
-    assert_parses_to "(let ((foo 2)) (+ foo 2))", [:let, [[:foo, 2]], [:+, :foo, 2]]
+    assert_parses_to "(let ((foo 2)) (+ foo 2))", [:let.sym, [[:foo.sym, 2]], [:+.sym, :foo.sym, 2]]
   end
 
   def test_whitespace_indifferent
@@ -70,16 +76,11 @@ class BusSchemeParserTest < Test::Unit::TestCase
   end
 
   def test_parses_vectors
-    assert_equal [:'(', :vector, 1, 2, :')'], BusScheme::tokenize("#(1 2)").flatten
-    assert_parses_to  "#(1 2)", [:vector, 1, 2]
-    assert_parses_to "#(1 (2 3 4)", [:vector, 1, [2, 3, 4]]
+    assert_equal [:'(', :vector.sym, 1, 2, :')'], BusScheme::tokenize("#(1 2)").flatten
+    assert_parses_to  "#(1 2)", [:vector.sym, 1, 2]
+    assert_parses_to "#(1 (2 3 4))", [:vector.sym, 1, [2, 3, 4]]
   end
   
-#   def test_parses_dotted_cons
-#     assert_parses_to "(22 . 11)", [:cons, 22, 11]
-#     assert_parses_to "((+ 2 2) . 11)", [:cons, [:+, 2, 2], 11]
-#   end
-
   def test_floats
     assert_parses_to "44.9", 44.9
     assert_parses_to "0.22", 0.22
@@ -99,15 +100,25 @@ class BusSchemeParserTest < Test::Unit::TestCase
     assert_parses_to "-0.10", -0.1
   end
 
+  def test_explicitly_positive_floats
+    assert_parses_to "+0.22", 0.22
+    assert_parses_to "+.22", 0.22
+    assert_parses_to "+0.10", 0.1
+  end
+
 #   def test_character_literals
-#     assert_parses_to "?#e", "e"
-#     assert_parses_to "?#A", "A"
+#     assert_parses_to "#\e", "e"
+#     assert_parses_to "#\A", "A"
+#     assert_parses_to "#\(", "("
+#     assert_parses_to "#\space", ' '
+#     assert_parses_to "#\newline", "\n"
 #   end
   
   def test_quote
-    assert_parses_to "'foo", [:quote, :foo]
-    assert_equal [:'(', :quote, :'(', :foo, :bar, :baz, :')', :')'], BusScheme::tokenize("'(foo bar baz)").flatten
-    assert_parses_to "'(foo bar baz)", [:quote, [:foo, :bar, :baz]]
+    assert_parses_to "'foo", [:quote.sym, :foo.sym]
+    assert_equal [:'(', :quote.sym, :'(', :foo.sym, :bar.sym, :baz.sym, :')', :')'], BusScheme::tokenize("'(foo bar baz)").flatten
+    assert_parses_to "'(foo bar baz)", [:quote.sym, [:foo.sym, :bar.sym, :baz.sym]]
+    assert_parses_to "'(+ 20 3)", [:quote.sym, [:+.sym, 20, 3]]
   end
 
   #  have to change normalize_whitespace to not turn newlines into spaces for this to work
@@ -115,7 +126,26 @@ class BusSchemeParserTest < Test::Unit::TestCase
     assert_parses_to ";; hello", nil
     assert_parses_to "12 ;; comment", 12
     assert_parses_to "(+ 2;; this is a mid-sexp comment
-2)", [:+, 2, 2]
+2)", [:+.sym, 2, 2]
+  end
+
+  def test_requires_closed_lists
+    assert_raises(IncompleteError) { BusScheme.parse "(+ 2 2" }
+    assert_raises(IncompleteError) { BusScheme.parse "(+ (* 3 4) 2 2" }
+  end
+  
+  def test_reject_bad_identifiers
+    ["14kalt", "-bolt", ".ab3"].each do |identifier|
+      assert_raises(ParseError, "#{identifier} should not be valid") { BusScheme.parse(identifier) }
+    end
+  end
+
+  def test_r5rs_identifiers
+    ["lambda", "q", "list->vector", "soup", "+",
+     "V17a", "<=?", "a34kTMNs",
+     "the-word-recursion-has-many-meanings"].each do |identifier|
+      assert_nothing_raised { BusScheme.parse(identifier) }
+    end
   end
   
   def test_parse_random_elisp_form_from_my_dot_emacs
@@ -125,17 +155,22 @@ class BusSchemeParserTest < Test::Unit::TestCase
     (if (file-exists-p system-specific-config)
         (load system-specific-config)))"
     assert_parses_to(lisp,
-                     [:let, [[:'system-specific-config',
-                              [:concat, "~/.emacs.d/",
-                               [:'shell-command-to-string', "hostname"]]]],
-                      [:if, [:'file-exists-p', :'system-specific-config'],
-                       [:load, :'system-specific-config']]])
+                     [:let.sym, [[:'system-specific-config'.sym,
+                              [:concat.sym, "~/.emacs.d/",
+                               [:'shell-command-to-string'.sym, "hostname"]]]],
+                      [:if.sym, [:'file-exists-p'.sym, :'system-specific-config'.sym],
+                       [:load.sym, :'system-specific-config'.sym]]])
    end
 
+  def test_parser_saves_file_info
+    tree = BusScheme.parse("(define foo 23)")
+    assert_equal "(eval)", tree.cdr.car.file
+  end
+  
   private
 
   def assert_parses_to(actual_string, expected)
-    assert_equal expected, BusScheme.parse(actual_string)
+    assert_equal expected.sexp(true), BusScheme.parse(actual_string)
   end
 
   def assert_parses_equal(one, two, message = nil)

data/test/test_predicates.scm

@@ -0,0 +1,24 @@
+;; still to test: number? vector? procedure? char? port?
+
+(assert (boolean? (> 3 2)))
+(assert (boolean? (> 1 2)))
+(assert (not (boolean? 3)))
+(assert (not (boolean? "hi")))
+(assert (not (boolean? >)))
+
+(assert (symbol? 'hi))
+(assert (symbol? (quote hullo)))
+(assert (not (symbol? "hi")))
+(assert (not (symbol? 23)))
+(assert (not (symbol? assert)))
+
+(assert (cons? (cons 1 2)))
+(assert (cons? cons?))
+(assert (not (cons? 2)))
+(assert (not (cons? #t)))
+(assert (pair? (cons 1 2)))
+
+(assert (string? "h"))
+(assert (string? "hello"))
+(assert (not (string? 'hi)))
+(assert (not (string? string?)))

data/test/test_primitives.rb

@@ -2,93 +2,43 @@ $LOAD_PATH << File.dirname(__FILE__)
 require 'test_helper'
 
 class PrimitivesTest < Test::Unit::TestCase
-  def test_booleans
-    assert BusScheme::PRIMITIVES.has_key? '#f'.intern
-    assert_evals_to false, '#f'
-    assert_evals_to true, '#t'
-  end
-
-  def test_arithmetic
-    assert_evals_to 2, [:'-', 4, 2]
-    assert_evals_to 2, [:'/', 4, 2]
-    assert_evals_to 2, [:'*', 1, 2]
-  end
-
-  def test_many_args_for_arithmetic
-    assert_evals_to 4, [:+, 1, 1, 1, 1]
-    assert_evals_to 2, [:*, 1, 2, 1, 1]
-  end
-
-  def test_concat
-    assert_evals_to "foobar", "(concat \"foo\" \"bar\")"
-  end
-
-  def test_eval
-    assert_evals_to 23, "(eval '(+ 20 3))"
-  end
-  
-  def test_eval_ruby
-    assert_evals_to "foofoofoo", "(ruby \"'foo' * 3\")"
-  end
-
-  def test_message_passing
-    assert_evals_to 7, "(send 3 (intern \"+\") 4)"
+  def test_test_framework
+    assert_raises(AssertionFailed) { eval "(assert (= 3 9))"}
+    assert_raises(AssertionFailed) { eval "(fail \"EPIC FAIL\")" }
   end
 
   def test_load_file
-    eval "(load \"#{File.dirname(__FILE__)}/foo.scm\")"
-    assert_evals_to 3, :foo
-  end
-
-  # special forms
-  def test_define
-    clear_symbols :foo
-    eval("(define foo 5)")
-    assert_equal 5, BusScheme::Lambda.scope[:foo]
-    eval("(define foo (quote (5 5 5))")
-    assert_evals_to [5, 5, 5].to_list, :foo
-  end
-
-  def test_define_returns_defined_term
-    assert_evals_to :foo, "(define foo 2)"
-    assert_equal 2, eval("foo")
-  end
-
-  def test_eval_quote
-    assert_evals_to [:'+', 2, 2].to_list, [:quote, [:'+', 2, 2]]
-  end
-
-  def test_quote
-    assert_evals_to :hi, [:quote, :hi]
-    assert_evals_to [:a, :b, :c].to_list, "'(a b c)"
-    assert_evals_to [:a].to_list, "(list 'a)"
-    assert_evals_to [:a, :b].to_list, "(list 'a 'b)"
-    assert_evals_to [:a, :b, :c].to_list, "(list 'a 'b 'c)"
-  end
-
-  def test_if
-    assert_evals_to 7, [:if, '#f'.intern, 3, 7]
-    assert_evals_to 3, [:if, [:>, 8, 2], 3, 7]
-  end
-
-  def test_begin
-    eval([:begin,
-          [:define, :foo, 779],
-          9])
-    assert_equal 779, BusScheme::SYMBOL_TABLE[:foo]
+    eval "(load \"#{File.dirname(__FILE__)}/../examples/fib.scm\")"
+    assert BusScheme[:fib.sym]
+    assert_evals_to 5, "(+ (fib 3) (fib 4))"
+    assert_evals_to 8, "(fib 6)"
+    assert_evals_to [1, 1, 2, 3, 5, 8].to_list, "(map fib (list 1 2 3 4 5 6))"
+  end
+
+  def test_load_path
+    examples = File.dirname(__FILE__) + '/../examples/'
+    eval "(set! load-path (cons \"#{examples}\" load-path))"
+    eval "(load \"fib.scm\")"
+    assert BusScheme[:fib.sym]
+    
+    clear_symbols :fib.sym
+    current = File.dirname(__FILE__)
+    eval "(set! load-path (cons \"#{current}\" load-path))"
+    eval "(load \"../examples/fib.scm\")"
+    assert BusScheme[:fib.sym]
   end
 
   def test_set!
-    clear_symbols(:foo)
+    clear_symbols(:foo.sym)
     # can only set! existing variables
     assert_raises(BusScheme::EvalError) { eval "(set! foo 7)" }
     eval "(define foo 3)"
     eval "(set! foo 7)"
-    assert_evals_to 7, :foo
+    assert_evals_to 7, :foo.sym
   end
 
   def test_consing
-    assert_evals_to BusScheme::Cons.new(:foo, :bar), "(cons (quote foo) (quote bar))"
+    assert_evals_to BusScheme::Cons.new(:foo.sym, :bar.sym), "(cons (quote foo) (quote bar))"
   end
 
   def test_vectors
@@ -97,22 +47,18 @@ class PrimitivesTest < Test::Unit::TestCase
 
   def test_inspect
     assert_equal "(1)", [1].to_list.inspect
-    assert_equal "(1 . 1)", BusScheme::Cons.new(1, 1).inspect
-    assert_equal "(1 1 1)", BusScheme::Cons.new(1, BusScheme::Cons.new(1, BusScheme::Cons.new(1))).inspect
+    assert_equal "(1 . 1)", Cons.new(1, 1).inspect
+    assert_equal "(1 1 1)", Cons.new(1, Cons.new(1, Cons.new(1, nil))).inspect
+    assert_equal "(1 1 1 . 8)", Cons.new(1, Cons.new(1, Cons.new(1, 8))).inspect
   end
 
-  def test_let
-    assert_evals_to 4, "(let ((x 2)
-                              (y 2))
-                           (+ x y))"
-
-    assert_evals_to 6, "(let ((doubler (lambda (x) (* 2 x)))
-                             (x 3))
-                           (doubler x))"
+  def test_boolean_short_circuit
+    assert_evals_to false, "(and #f (assert #f))"
+    assert_evals_to true, "(or #t (assert #f))"
+  end
 
-    assert_evals_to 6, "(let ((doubler (lambda (x) (* 2 x)))
-                             (x 3))
-                           x
-                           (doubler x))"
+  def test_booleans
+    assert_evals_to false, '#f'
+    assert_evals_to true, '#t'
   end
 end

data/test/test_primitives.scm

@@ -0,0 +1,55 @@
+(assert #t)
+
+;; Arithmetic
+(assert-equal 2 (+ 1 1))
+(assert-equal 2 (/ 4 2))
+(assert-equal 2 (* 1 2))
+
+(assert-equal 4 (+ 1 1 1 1))
+(assert-equal 2 (* 1 2 1 1))
+
+;; TODO: uncommenting this causes a blow-upey thing to happen
+;; (assert-equal 23 (eval '(+ 20 3)))
+(assert-equal "foobar" (concat "foo" "bar"))
+(assert-equal "foofoofoo" (ruby "'foo' * 3"))
+(assert-equal 7 (send 3 (string->symbol "+") 4))
+
+(assert-equal 9 (begin (define foo 779) 9))
+(assert-equal 779 foo)
+
+;; (assert (null? (cdr (cons 3))))
+
+;; define
+(define foo 5)
+(define bar (quote (5 5 5)))
+(assert-equal 5 foo)
+(assert-equal (list 5 5 5) bar)
+
+(assert-equal 'foo (define foo 5))
+
+;;  special forms
+(assert-equal 7 (if #f 3 7))
+(assert-equal 3 (if (> 8 2) 3 7))
+
+(assert-equal 4 (let ((x 2)
+		      (y 2))
+		  (+ x y)))
+(assert-equal 6 (let ((doubler (lambda (x) (* 2 x)))
+		      (x 3))
+		  (doubler x)))
+
+(assert-equal #t (and #t #t))
+(assert-equal #f (and #t #f))
+(assert-equal #f (and #f #t))
+(assert-equal #f (and #f #f))
+
+(assert-equal #t (or #t #t))
+(assert-equal #t (or #t #f))
+(assert-equal #t (or #f #t))
+(assert-equal #f (or #f #f))
+
+; (load "../examples/fib.scm")
+; (assert fib)
+
+; (assert-equal (list 1 1 2 3 5 8)
+;	      (map fib (list 1 2 3 4 5 6)))

data/test/test_stack_frame.rb

@@ -0,0 +1,30 @@
+$LOAD_PATH << File.dirname(__FILE__)
+require 'test_helper'
+
+class StackFrameTest < Test::Unit::TestCase
+  def setup
+    @parent = {:foo => "FOO", :baz => 'BAZ'}
+    @h = StackFrame.new({:foo => 'foo', :bar => 'bar'},
+                           @parent, eval("(lambda () 1)"))
+  end
+  
+  def test_has_key?
+    assert @h.has_key?(:foo)
+    assert @h.has_key?(:bar)
+    assert @h.has_key?(:baz)
+
+    assert @parent.has_key?(:baz)
+    assert @parent.has_key?(:foo)
+    assert !@parent.has_key?(:bar)
+
+    assert @h.immediate_has_key?(:foo)
+    assert @h.immediate_has_key?(:bar)
+    assert !@h.immediate_has_key?(:baz)
+  end
+
+  def test_setting_doesnt_alter_parent
+    @h[:foo] = "fooooooo"
+    assert_equal "fooooooo", @h[:foo]
+    assert_equal "FOO", @parent[:foo]
+  end
+end