+
+sub pp_roundtrip {
+ my ($string) = @_;
+ my $pp = uc App::Scheme79asm::Compiler::pretty_print(to_sexp $string);
+ is $pp, uc($string), "pretty_print roundtrip $string";
+}
+
+pp_roundtrip '()';
+pp_roundtrip 't';
+pp_roundtrip '(lambda append (x y) (if (atom x) y (cons (car x) (append (cdr x) y))))';
+
+sub expect_error_like (&$) {
+ my ($block, $error_re) = @_;
+ my $name = "test error like /$error_re/";
+ my $result = eval { $block->(); 1 };
+ if ($result) {
+ note 'Block did not throw an exception, failing test';
+ fail $name;
+ } else {
+ like $@, qr/$error_re/, $name;
+ }
+}
+
+expect_error_like { new->process_quoted([]) } 'argument to process_quoted is not a scalar, cons, or nil';
+expect_error_like { is_toplevel 'x' } 'Variable x not in environment';
+expect_error_like { is_toplevel '(car)' } 'Cannot call primitive car with no arguments';