[svn:parrot] r9848 - in trunk: . ast docs examples/past lib/Parrot t/examples

Tue, 08 Nov 2005 12:11:55 -0800 

Author: bernhard
Date: Tue Nov  8 12:11:39 2005
New Revision: 9848

Added:
   trunk/examples/past/
   trunk/examples/past/hello.past
      - copied unchanged from r9846, trunk/ast/hello.past
   trunk/t/examples/past.t
      - copied, changed from r9846, trunk/t/examples/pir.t
Removed:
   trunk/ast/hello.past
Modified:
   trunk/MANIFEST
   trunk/docs/glossary.pod
   trunk/lib/Parrot/Test.pm
Log:
Move hello.past to 'examples/past'.
Add PAST test functions to Parrot::Test.
Add a test for 'examples/past/hello.past'


Modified: trunk/MANIFEST
==============================================================================
--- trunk/MANIFEST      (original)
+++ trunk/MANIFEST      Tue Nov  8 12:11:39 2005
@@ -21,6 +21,7 @@ RELEASE_INSTRUCTIONS                    
 RESPONSIBLE_PARTIES                               [main]doc
 TODO                                              [main]doc
 VERSION                                           [main]doc
+ast/README                                        []
 ast/ast.h                                         []
 ast/ast.l                                         []
 ast/ast.y                                         []
@@ -28,7 +29,6 @@ ast/ast_main.c                          
 ast/astlexer.c                                    []
 ast/astparser.c                                   []
 ast/astparser.h                                   []
-ast/hello.past                                    []
 ast/node.c                                        []
 build_tools/build_nativecall.pl                   []
 build_tools/c2str.pl                              []
@@ -592,6 +592,7 @@ examples/pasm/small.xml                 
 examples/pasm/stack.pasm                          [main]doc
 examples/pasm/trace.pasm                          [main]doc
 examples/pasm/xml_parser.pasm                     [main]doc
+examples/past/hello.past                          []
 examples/pge/README                               [main]doc
 examples/pge/all.pir                              [main]doc
 examples/pge/p6parse.pir                          [main]doc
@@ -1815,6 +1816,7 @@ t/dynclass/pyint.t                      
 t/examples/japh.t                                 []
 t/examples/library.t                              []
 t/examples/pasm.t                                 []
+t/examples/past.t                                 []
 t/examples/pir.t                                  []
 t/examples/subs.t                                 []
 t/harness                                         []

Modified: trunk/docs/glossary.pod
==============================================================================
--- trunk/docs/glossary.pod     (original)
+++ trunk/docs/glossary.pod     Tue Nov  8 12:11:39 2005
@@ -198,6 +198,10 @@ This let's Parrot talk to native "C" lib
 
 Acronym for Native Call Interface.
 
+=head2 PAST
+
+Acronym for Parrot Abstract Syntax Tree.
+
 =head2 Packfile
 
 Another name for a PBC file, due to the names used for data structures in one

Modified: trunk/lib/Parrot/Test.pm
==============================================================================
--- trunk/lib/Parrot/Test.pm    (original)
+++ trunk/lib/Parrot/Test.pm    Tue Nov  8 12:11:39 2005
@@ -55,6 +55,21 @@ the  output matches the expected result.
 Runs the Parrot Assembler code and passes the test
 if a string comparison of the output with the unexpected result is false.
 
+=item C<past_output_is($code, $expected, $description)>
+
+Runs the PAST code and passes the test if a string comparison of output
+with the expected result is true.
+
+=item C<past_output_like($code, $expected, $description)>
+
+Runs the PAST code and passes the test if output matches the expected
+result.
+
+=item C<past_output_isnt($code, $unexpected, $description)>
+
+Runs the PAST code and passes the test if a string comparison of the output
+with the unexpected result is false.
+
 =item C<pir_output_is($code, $expected, $description)>
 
 Runs the PIR code and passes the test if a string comparison of output
@@ -160,6 +175,7 @@ require Test::More;
 
 @EXPORT = qw( output_is          output_like          output_isnt
               pasm_output_is     pasm_output_like     pasm_output_isnt
+              past_output_is     past_output_like     past_output_isnt
               pir_output_is      pir_output_like      pir_output_isnt
               pir_2_pasm_is      pir_2_pasm_like      pir_2_pasm_isnt
               pbc_output_is      pbc_output_like      pbc_output_isnt
@@ -309,6 +325,9 @@ sub _generate_functions {
         pasm_output_is     => 'is_eq',
         pasm_output_isnt   => 'isnt_eq',
         pasm_output_like   => 'like',
+        past_output_is     => 'is_eq',
+        past_output_isnt   => 'isnt_eq',
+        past_output_like   => 'like',
         pir_output_is      => 'is_eq',
         pir_output_isnt    => 'isnt_eq',
         pir_output_like    => 'like',
@@ -342,16 +361,19 @@ sub _generate_functions {
             # Name of the file with test code.
             # This depends on which kind of code we are testing.
             my $code_f;
-            if ( $func =~ /^pir_output/ ) {
+            if ( $func =~ m/^pir_output/ ) {
                 $code_f = per_test('.pir', $test_no);
             }
             elsif ( $func =~ m/^output_/ || $func =~ m/^pasm_output_/ ) {
                 $code_f = per_test('.pasm', $test_no);
             }
-            elsif ( $func =~ /^pir_2_pasm_/) {
+            elsif ( $func =~ m/^past_/) {
+                $code_f = per_test('.past', $test_no);
+            }
+            elsif ( $func =~ m/^pir_2_pasm_/) {
                 $code_f = per_test('.pir', $test_no);
             }
-            elsif ( $func =~ /^pbc_output_/ ) {
+            elsif ( $func =~ m/^pbc_output_/ ) {
                 $code_f = per_test('.pbc', $test_no);
             }
             else {

Copied: trunk/t/examples/past.t (from r9846, trunk/t/examples/pir.t)
==============================================================================
--- trunk/t/examples/pir.t      (original)
+++ trunk/t/examples/past.t     Tue Nov  8 12:11:39 2005
@@ -4,21 +4,20 @@
 
 =head1 NAME
 
-t/examples/pir.t - Test examples in F<examples/pir>
+t/examples/pir.t - Test examples in F<examples/past>
 
 =head1 SYNOPSIS
 
-    % perl -Ilib t/examples/pir.t
+    % perl -Ilib t/examples/past.t
 
-    % perl t/harness t/examples/pir.t
+    % perl t/harness t/examples/past.t
 
 =head1 DESCRIPTION
 
-Test the examples in F<examples/pir>.
+Test the examples in F<examples/past>.
 
 =head1 TODO
 
-Check on remaining examples.
 Perhaps use Parrot::Test::run_command().
 
 =head1 SEE ALSO
@@ -32,7 +31,7 @@ Bernhard Schmalhofer - <Bernhard.Schmalh
 =cut
 
 use strict;
-use Parrot::Test tests => 10;
+use Parrot::Test tests => 1;
 use Test::More;
 use Parrot::Config;
 
@@ -40,167 +39,24 @@ my $PARROT = ".$PConfig{slash}$PConfig{t
 
 # Set up expected output for examples
 my %expected = (
-    'circle.pir'        =>  << 'END_EXPECTED',
-********************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************
-END_EXPECTED
-    'euclid.pir'        =>  << 'END_EXPECTED',
-Algorithm E (Euclid's algorithm)
-The greatest common denominator of 96 and 64 is 32.
-END_EXPECTED
-
-    'hanoi.pir'        =>  << 'END_EXPECTED',
-Using default size 3 for tower.
-
-       |        |       
- ====  |        |       
-====== |        |   ==  
-
-       |        |       
-       |        |       
-====== |  ====  |   ==  
-
-       |        |       
-       |   ==   |       
-====== |  ====  |       
-
-       |        |       
-       |   ==   |       
-       |  ====  | ======
-
-       |        |       
-       |        |       
-  ==   |  ====  | ======
-
-       |        |       
-       |        |  ==== 
-  ==   |        | ======
-
-       |        |   ==  
-       |        |  ==== 
-       |        | ======
-
-END_EXPECTED
-
-    'io.pir'            =>  << 'END_EXPECTED',
-test4
-test5
-test1
-test2
-test3
-END_EXPECTED
-
-    'local_label.pir'            =>  << 'END_EXPECTED',
-Branching to '$ok' in macro 'TEST1'
-Branched to '$ok' in macro 'TEST1'
-After .TEST1 ()
-Branching to '$ok' in macro 'TEST2'
-Branched to '$ok' in macro 'TEST2'
-Branched to 'non_local' in sub 'example'
-END_EXPECTED
-
-    'mandel.pir'        =>  << 'END_EXPECTED',
-................::::::::::::::::::::::::::::::::::::::::::::...............
-...........::::::::::::::::::::::::::::::::::::::::::::::::::::::..........
-........::::::::::::::::::::::::::::::::::,,,,,,,:::::::::::::::::::.......
-.....:::::::::::::::::::::::::::::,,,,,,,,,,,,,,,,,,,,,,:::::::::::::::....
-...::::::::::::::::::::::::::,,,,,,,,,,,,;;;!:H!!;;;,,,,,,,,:::::::::::::..
-:::::::::::::::::::::::::,,,,,,,,,,,,,;;;;!!/>&*|& !;;;,,,,,,,:::::::::::::
-::::::::::::::::::::::,,,,,,,,,,,,,;;;;;!!//)|.*#|>/!;;;;;,,,,,,:::::::::::
-::::::::::::::::::,,,,,,,,,,,,;;;;;;!!!!//>|:    !:|//!!;;;;;,,,,,:::::::::
-:::::::::::::::,,,,,,,,,,;;;;;;;!!/>>I>>)||I#     H&))>////*!;;,,,,::::::::
-::::::::::,,,,,,,,,,;;;;;;;;;!!!!/>H:  #|              IH&*I#/;;,,,,:::::::
-::::::,,,,,,,,,;;;;;!!!!!!!!!!//>|.H:                     #I>!!;;,,,,::::::
-:::,,,,,,,,,;;;;!/||>///>>///>>)|H                         %|&/;;,,,,,:::::
-:,,,,,,,,;;;;;!!//)& :;I*,H#&||&/                           *)/!;;,,,,,::::
-,,,,,,;;;;;!!!//>)IH:,        ##                            #&!!;;,,,,,::::
-,;;;;!!!!!///>)H%.**           *                            )/!;;;,,,,,::::
-                                                          &)/!!;;;,,,,,::::
-,;;;;!!!!!///>)H%.**           *                            )/!;;;,,,,,::::
-,,,,,,;;;;;!!!//>)IH:,        ##                            #&!!;;,,,,,::::
-:,,,,,,,,;;;;;!!//)& :;I*,H#&||&/                           *)/!;;,,,,,::::
-:::,,,,,,,,,;;;;!/||>///>>///>>)|H                         %|&/;;,,,,,:::::
-::::::,,,,,,,,,;;;;;!!!!!!!!!!//>|.H:                     #I>!!;;,,,,::::::
-::::::::::,,,,,,,,,,;;;;;;;;;!!!!/>H:  #|              IH&*I#/;;,,,,:::::::
-:::::::::::::::,,,,,,,,,,;;;;;;;!!/>>I>>)||I#     H&))>////*!;;,,,,::::::::
-::::::::::::::::::,,,,,,,,,,,,;;;;;;!!!!//>|:    !:|//!!;;;;;,,,,,:::::::::
-::::::::::::::::::::::,,,,,,,,,,,,,;;;;;!!//)|.*#|>/!;;;;;,,,,,,:::::::::::
-:::::::::::::::::::::::::,,,,,,,,,,,,,;;;;!!/>&*|& !;;;,,,,,,,:::::::::::::
-...::::::::::::::::::::::::::,,,,,,,,,,,,;;;!:H!!;;;,,,,,,,,:::::::::::::..
-.....:::::::::::::::::::::::::::::,,,,,,,,,,,,,,,,,,,,,,:::::::::::::::....
-........::::::::::::::::::::::::::::::::::,,,,,,,:::::::::::::::::::.......
-...........::::::::::::::::::::::::::::::::::::::::::::::::::::::..........
-END_EXPECTED
-
-    'substr.pir'            =>  << 'END_EXPECTED',
-
-H
-He
-Hel
-Hell
-Hello
-Hello 
-Hello W
-Hello Wo
-Hello Wor
-Hello Worl
-Hello World
-Hello Worl
-Hello Wor
-Hello Wo
-Hello W
-Hello 
-Hello
-Hell
-Hel
-He
-H
-
-END_EXPECTED
-
-    'sudoku.pir'        =>  << 'END_EXPECTED',
-+---------+---------+---------+
-| 1  .  . | .  .  . | .  .  . |
-| .  .  2 | 7  4  . | .  .  . |
-| .  .  . | 5  .  . | .  .  4 |
-+---------+---------+---------+
-| .  3  . | .  .  . | .  .  . |
-| 7  5  . | .  .  . | .  .  . |
-| .  .  . | .  .  9 | 6  .  . |
-+---------+---------+---------+
-| .  4  . | .  .  6 | .  .  . |
-| .  .  . | .  .  . | .  7  1 |
-| .  .  . | .  .  1 | .  3  . |
-+---------+---------+---------+
-init ok
-+---------+---------+---------+
-| 1  8  4 | 9  6  3 | 7  2  5 |
-| 5  6  2 | 7  4  8 | 3  1  9 |
-| 3  9  7 | 5  1  2 | 8  6  4 |
-+---------+---------+---------+
-| 2  3  9 | 6  5  7 | 1  4  8 |
-| 7  5  6 | 1  8  4 | 2  9  3 |
-| 4  1  8 | 2  3  9 | 6  5  7 |
-+---------+---------+---------+
-| 9  4  1 | 3  7  6 | 5  8  2 |
-| 6  2  3 | 8  9  5 | 4  7  1 |
-| 8  7  5 | 4  2  1 | 9  3  6 |
-+---------+---------+---------+
-solved
+    'hello.past'        =>  << 'END_EXPECTED',
+Hello PAST
 END_EXPECTED
                           );
 
 # Do the testing
 my %test_func = ( pasm => \&pasm_output_is,
+                  past => \&past_output_is,
                   pir  => \&pir_output_is,
                   imc  => \&pir_output_is );
 
 while ( my ( $example, $expected ) = each %expected ) {
-    my $code_fn   = "examples/pir/$example";
+    my $code_fn   = "examples/past/$example";
     my $code = Parrot::Test::slurp_file($code_fn);
 
-    my ( $extension ) = $example =~ m{ [.]                  # introducing 
extension
-                                       ( pasm | pir | imc ) # match and 
capture the extension
-                                       \z                   # at end of string
+    my ( $extension ) = $example =~ m{ [.]                         # 
introducing extension
+                                       ( pasm | pir | imc | past ) # match and 
capture the extension
+                                       \z                          # at end of 
string
                                      }ixms or Usage();
     if ( defined $extension ) { 
       $test_func{$extension}->($code, $expected, $code_fn);
@@ -209,27 +65,3 @@ while ( my ( $example, $expected ) = eac
       ok( defined $extension, "no extension recognized for $code_fn" );
     }
 }
-
-# For testing life.pir, the number of generations should be small,
-# because users should not get bored.
-{
-    my $life_fn = "examples$PConfig{slash}pir$PConfig{slash}life.pir";
-    my $sum = `$PARROT $life_fn 4`;
-    like( $sum, qr/4 generations in/, 'life ran for 4 generations' );
-}
-
-# readline.pir expects something on standard input 
-{
-    my $readline_pir_fn = 
"examples$PConfig{slash}pir$PConfig{slash}readline.pir";
-    my $readline_tmp_fn = "test_readline.tmp";
-    open( my $tmp, '>', $readline_tmp_fn );
-    print $tmp "first line\n\nlast line\n";
-    close $tmp;
-    my $expected = << 'END_EXPECTED';
-first line
-END_EXPECTED
-    my $out = `$PARROT $readline_pir_fn < $readline_tmp_fn`;
-    is( $out, $expected, 'print until first empty line' );
-    unlink( $readline_tmp_fn );
-}
-

Reply via email to