[svn:parrot] r18981 - in trunk/languages/lisp: lib/Parrot/Test t

[bernhard]

Author: bernhard
Date: Wed Jun 13 11:42:59 2007
New Revision: 18981

Modified:
   trunk/languages/lisp/lib/Parrot/Test/Lisp.pm
   trunk/languages/lisp/t/atoms.t
   trunk/languages/lisp/t/basic.t

Log:
[languages/lisp]
Add support for TODO tests in Parrot::Test::Lisp.
Add some tests, including some TODO tests.


Modified: trunk/languages/lisp/lib/Parrot/Test/Lisp.pm
==============================================================================
--- trunk/languages/lisp/lib/Parrot/Test/Lisp.pm        (original)
+++ trunk/languages/lisp/lib/Parrot/Test/Lisp.pm        Wed Jun 13 11:42:59 2007
@@ -20,10 +20,17 @@
 }
 
 sub output_is {
-    my ( $self, $code, $output, $desc ) = @_;
+    my ( $self, $code, $output, $desc, %extra ) = @_;
 
     my $count = $self->{builder}->current_test() + 1;
 
+    # set a TODO for Test::Builder to find
+    my $call_pkg = $self->{builder}->exported_to() || '';
+
+    no strict 'refs';
+    local *{ $call_pkg . '::TODO' } = \$extra{todo}
+        if defined $extra{todo};
+
     my $lang_fn = File::Spec->rel2abs(Parrot::Test::per_test( '.l',  $count ));
     my $out_fn  = File::Spec->rel2abs(Parrot::Test::per_test( '.out', $count 
));
     Parrot::Test::write_code_to_file( $code, $lang_fn );

Modified: trunk/languages/lisp/t/atoms.t
==============================================================================
--- trunk/languages/lisp/t/atoms.t      (original)
+++ trunk/languages/lisp/t/atoms.t      Wed Jun 13 11:42:59 2007
@@ -38,23 +38,53 @@
     ],
     [ q{ 0 },
       0,
-      'zero'
+      'zero',
+      todo => '0 is still strange',
     ],
     [ q{ nil },
       'NIL',
       'false'
     ],
+    [ q{ NIL },
+      'NIL',
+      'NIL'
+    ],
+    [ q{ Nil },
+      'NIL',
+      'Nil'
+    ],
     [ q{ t },
       'T',
       'true'
     ],
+    [ q{ T },
+      'T',
+      'true'
+    ],
+    [ q{ () },
+      'NIL',
+      'empty list is NIL'
+    ],
+    [ q{ (atom 0) },
+      'T',
+      'integer 0 is an atom',
+      todo => '0 is still strange',
+    ],
+    [ q{ (atom 999) },
+      'T',
+      'integer 999 is an atom'
+    ],
+    [ q{ (atom "neunhundertneunundneunzig") },
+      'T',
+      'string 999 is an atom'
+    ],
 );
 
 Test::More::plan( tests => scalar @test_cases );
 
 foreach ( @test_cases )
 {
-     my ( $code, $out, $desc ) = @{ $_ };
+    my ( $code, $out, $desc, @other ) = @{ $_ };
 
-     language_output_is( 'Lisp', "( print $code )", $out . "\n", $desc );
+    language_output_is( 'Lisp', "( print $code )", $out . "\n", $desc, @other 
);
 }

Modified: trunk/languages/lisp/t/basic.t
==============================================================================
--- trunk/languages/lisp/t/basic.t      (original)
+++ trunk/languages/lisp/t/basic.t      Wed Jun 13 11:42:59 2007
@@ -24,6 +24,15 @@
 use Parrot::Test;
 
 my @test_cases = (
+    [ q{  (print '(1 2)) },
+      q{(1 . (2 . NIL))},
+      q{function apply},
+    ],
+    [ q{ ( setq my_function '+) ( print (apply my_function '(1 2)) ) },
+      q{3},
+      q{function apply},
+      todo => 'apply does not evaluate',
+    ],
     [ q{ ( print ( list 1 2 ) ) },
       q{(1 . (2 . NIL))},
     ],
@@ -45,14 +54,17 @@
     [ q{ ( setq asdf 1234 ) ( print asdf ) },
       q{1234},
     ],
+    [ q{ ( setq asdf 1234 ) ( print asdf ) },
+      q{1234},
+    ],
 );
 
 Test::More::plan( tests => scalar @test_cases );
 
 foreach ( @test_cases )
 {
-     my ( $code, $out, $desc ) = @{ $_ };
+    my ( $code, $out, $desc, @other ) = @{ $_ };
 
-     $desc ||= substr( $code, 0, 32 ); 
-     language_output_is( 'Lisp', $code, $out . "\n", $desc );
+    $desc ||= substr( $code, 0, 32 ); 
+    language_output_is( 'Lisp', $code, $out . "\n", $desc, @other );
 }