t/examples/pir.t

   1 #!perl
   2 # Copyright (C) 2005-2009, Parrot Foundation.
   3 # $Id$
   4
   5 use strict;
   6 use warnings;
   7 use lib qw( . lib ../lib ../../lib );
   8
   9 use Test::More;
  10 use Parrot::Test tests => 18;
  11 use Parrot::Config;
  12
  13 =head1 NAME
  14
  15 t/examples/pir.t - Test examples in F<examples/pir>
  16
  17 =head1 SYNOPSIS
  18
  19     % prove t/examples/pir.t
  20
  21 =head1 DESCRIPTION
  22
  23 Test the examples in F<examples/pir>.
  24
  25 =head1 SEE ALSO
  26
  27 F<t/examples/pasm.t>
  28
  29 =head1 AUTHOR
  30
  31 Bernhard Schmalhofer - <Bernhard.Schmalhofer@gmx.de>
  32
  33 =cut
  34
  35 # Set up expected output for examples
  36 my %expected = (
  37     'circle.pir' => << 'END_EXPECTED',
  38 \e[H\e[2J\e[23;40H*\e[23;40H*\e[23;41H*\e[23;41H*\e[23;42H*\e[23;42H*\e[23;43H*\e[23;44H*\e[23;44H*\e[23;45H*\e[23;45H*\e[23;46H*\e[23;46H*\e[23;47H*\e[22;48H*\e[22;48H*\e[22;49H*\e[22;49H*\e[22;50H*\e[22;50H*\e[22;51H*\e[22;52H*\e[22;52H*\e[22;53H*\e[22;53H*\e[22;54H*\e[22;54H*\e[22;55H*\e[22;55H*\e[22;56H*\e[22;56H*\e[21;57H*\e[21;58H*\e[21;58H*\e[21;59H*\e[21;59H*\e[21;60H*\e[21;60H*\e[21;61H*\e[21;61H*\e[21;62H*\e[21;62H*\e[20;62H*\e[20;63H*\e[20;63H*\e[20;64H*\e[20;64H*\e[20;65H*\e[20;65H*\e[20;66H*\e[20;66H*\e[19;66H*\e[19;67H*\e[19;67H*\e[19;68H*\e[19;68H*\e[19;68H*\e[19;69H*\e[18;69H*\e[18;70H*\e[18;70H*\e[18;70H*\e[18;71H*\e[18;71H*\e[18;71H*\e[17;72H*\e[17;72H*\e[17;72H*\e[17;72H*\e[17;73H*\e[17;73H*\e[17;73H*\e[16;74H*\e[16;74H*\e[16;74H*\e[16;74H*\e[16;75H*\e[16;75H*\e[15;75H*\e[15;75H*\e[15;75H*\e[15;76H*\e[15;76H*\e[15;76H*\e[14;76H*\e[14;76H*\e[14;76H*\e[14;77H*\e[14;77H*\e[14;77H*\e[13;77H*\e[13;77H*\e[13;77H*\e[13;77H*\e[13;77H*\e[12;77H*\e[12;77H*\e[12;77H*\e[12;77H*\e[12;77H*\e[12;77H*\e[12;77H*\e[12;77H*\e[12;77H*\e[12;77H*\e[12;77H*\e[12;77H*\e[11;77H*\e[11;77H*\e[11;77H*\e[11;77H*\e[11;77H*\e[10;77H*\e[10;77H*\e[10;77H*\e[10;77H*\e[10;76H*\e[10;76H*\e[9;76H*\e[9;76H*\e[9;76H*\e[9;76H*\e[9;75H*\e[9;75H*\e[8;75H*\e[8;75H*\e[8;75H*\e[8;74H*\e[8;74H*\e[8;74H*\e[7;74H*\e[7;73H*\e[7;73H*\e[7;73H*\e[7;72H*\e[7;72H*\e[7;72H*\e[6;72H*\e[6;71H*\e[6;71H*\e[6;71H*\e[6;70H*\e[6;70H*\e[5;70H*\e[5;69H*\e[5;69H*\e[5;68H*\e[5;68H*\e[5;68H*\e[5;67H*\e[5;67H*\e[4;66H*\e[4;66H*\e[4;66H*\e[4;65H*\e[4;65H*\e[4;64H*\e[4;64H*\e[4;63H*\e[3;63H*\e[3;62H*\e[3;62H*\e[3;61H*\e[3;61H*\e[3;60H*\e[3;60H*\e[3;59H*\e[3;59H*\e[3;58H*\e[2;58H*\e[2;57H*\e[2;57H*\e[2;56H*\e[2;56H*\e[2;55H*\e[2;55H*\e[2;54H*\e[2;54H*\e[2;53H*\e[2;52H*\e[2;52H*\e[2;51H*\e[2;51H*\e[1;50H*\e[1;50H*\e[1;49H*\e[1;48H*\e[1;48H*\e[1;47H*\e[1;47H*\e[1;46H*\e[1;46H*\e[1;45H*\e[1;44H*\e[1;44H*\e[1;43H*\e[1;43H*\e[1;42H*\e[1;41H*\e[1;41H*\e[1;40H*\e[1;40H*\e[1;40H*\e[1;39H*\e[1;39H*\e[1;38H*\e[1;38H*\e[1;37H*\e[1;36H*\e[1;36H*\e[1;35H*\e[1;35H*\e[1;34H*\e[1;33H*\e[1;33H*\e[1;32H*\e[1;32H*\e[1;31H*\e[1;30H*\e[1;30H*\e[1;29H*\e[2;29H*\e[2;28H*\e[2;28H*\e[2;27H*\e[2;26H*\e[2;26H*\e[2;25H*\e[2;25H*\e[2;24H*\e[2;24H*\e[2;23H*\e[2;23H*\e[2;22H*\e[2;22H*\e[3;21H*\e[3;21H*\e[3;20H*\e[3;20H*\e[3;19H*\e[3;19H*\e[3;18H*\e[3;18H*\e[3;17H*\e[3;17H*\e[4;16H*\e[4;16H*\e[4;15H*\e[4;15H*\e[4;14H*\e[4;14H*\e[4;13H*\e[4;13H*\e[5;13H*\e[5;12H*\e[5;12H*\e[5;11H*\e[5;11H*\e[5;11H*\e[5;10H*\e[5;10H*\e[6;9H*\e[6;9H*\e[6;9H*\e[6;8H*\e[6;8H*\e[6;8H*\e[7;7H*\e[7;7H*\e[7;7H*\e[7;6H*\e[7;6H*\e[7;6H*\e[7;6H*\e[8;5H*\e[8;5H*\e[8;5H*\e[8;5H*\e[8;4H*\e[8;4H*\e[9;4H*\e[9;4H*\e[9;4H*\e[9;3H*\e[9;3H*\e[10;3H*\e[10;3H*\e[10;3H*\e[10;3H*\e[10;2H*\e[10;2H*\e[11;2H*\e[11;2H*\e[11;2H*\e[11;2H*\e[11;2H*\e[11;2H*\e[12;2H*\e[12;2H*\e[12;2H*\e[12;2H*\e[12;2H*\e[12;2H*\e[12;2H*\e[12;2H*\e[12;2H*\e[12;2H*\e[12;2H*\e[13;2H*\e[13;2H*\e[13;2H*\e[13;2H*\e[13;2H*\e[14;2H*\e[14;2H*\e[14;2H*\e[14;3H*\e[14;3H*\e[14;3H*\e[15;3H*\e[15;3H*\e[15;3H*\e[15;4H*\e[15;4H*\e[16;4H*\e[16;4H*\e[16;4H*\e[16;5H*\e[16;5H*\e[16;5H*\e[17;5H*\e[17;6H*\e[17;6H*\e[17;6H*\e[17;6H*\e[17;7H*\e[17;7H*\e[18;7H*\e[18;8H*\e[18;8H*\e[18;8H*\e[18;9H*\e[18;9H*\e[19;9H*\e[19;10H*\e[19;10H*\e[19;10H*\e[19;11H*\e[19;11H*\e[19;12H*\e[20;12H*\e[20;12H*\e[20;13H*\e[20;13H*\e[20;14H*\e[20;14H*\e[20;15H*\e[20;15H*\e[21;16H*\e[21;16H*\e[21;17H*\e[21;17H*\e[21;18H*\e[21;18H*\e[21;19H*\e[21;19H*\e[21;20H*\e[22;20H*\e[22;21H*\e[22;21H*\e[22;22H*\e[22;22H*\e[22;23H*\e[22;23H*\e[22;24H*\e[22;24H*\e[22;25H*\e[22;25H*\e[22;26H*\e[23;27H*\e[23;27H*\e[23;28H*\e[23;28H*\e[23;29H*\e[23;30H*\e[23;30H*\e[23;31H*\e[23;31H*\e[23;32H*\e[23;32H*\e[23;33H*\e[23;34H*\e[23;34H*\e[23;35H*\e[23;36H*\e[23;36H*\e[23;37H*\e[23;37H*\e[23;38H*\e[23;39H*\e[23;39H*\e[23;40H*\e[23;40H*\e[23;40H*\e[24;0H
  39 END_EXPECTED
  40     'euclid.pir' => << 'END_EXPECTED',
  41 Algorithm E (Euclid's algorithm)
  42 The greatest common denominator of 96 and 64 is 32.
  43 END_EXPECTED
  44
  45     'hanoi.pir' => << 'END_EXPECTED',
  46 Using default size 3 for tower.
  47
  48        |        |
  49  ====  |        |
  50 ====== |        |   ==
  51
  52        |        |
  53        |        |
  54 ====== |  ====  |   ==
  55
  56        |        |
  57        |   ==   |
  58 ====== |  ====  |
  59
  60        |        |
  61        |   ==   |
  62        |  ====  | ======
  63
  64        |        |
  65        |        |
  66   ==   |  ====  | ======
  67
  68        |        |
  69        |        |  ====
  70   ==   |        | ======
  71
  72        |        |   ==
  73        |        |  ====
  74        |        | ======
  75
  76 END_EXPECTED
  77
  78     'io.pir' => << 'END_EXPECTED',
  79 test4
  80 test5
  81 \0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0test1
  82 test2
  83 test3
  84 END_EXPECTED
  85
  86     'local_label.pir' => << 'END_EXPECTED',
  87 Branching to '$ok' in macro 'TEST1'
  88 Branched to '$ok' in macro 'TEST1'
  89 After .TEST1 ()
  90 Branching to '$ok' in macro 'TEST2'
  91 Branched to '$ok' in macro 'TEST2'
  92 Branched to 'non_local' in sub 'example'
  93 END_EXPECTED
  94
  95     'mandel.pir' => << 'END_EXPECTED',
  96 ................::::::::::::::::::::::::::::::::::::::::::::...............
  97 ...........::::::::::::::::::::::::::::::::::::::::::::::::::::::..........
  98 ........::::::::::::::::::::::::::::::::::,,,,,,,:::::::::::::::::::.......
  99 .....:::::::::::::::::::::::::::::,,,,,,,,,,,,,,,,,,,,,,:::::::::::::::....
 100 ...::::::::::::::::::::::::::,,,,,,,,,,,,;;;!:H!!;;;,,,,,,,,:::::::::::::..
 101 :::::::::::::::::::::::::,,,,,,,,,,,,,;;;;!!/>&*|& !;;;,,,,,,,:::::::::::::
 102 ::::::::::::::::::::::,,,,,,,,,,,,,;;;;;!!//)|.*#|>/!;;;;;,,,,,,:::::::::::
 103 ::::::::::::::::::,,,,,,,,,,,,;;;;;;!!!!//>|:    !:|//!!;;;;;,,,,,:::::::::
 104 :::::::::::::::,,,,,,,,,,;;;;;;;!!/>>I>>)||I#     H&))>////*!;;,,,,::::::::
 105 ::::::::::,,,,,,,,,,;;;;;;;;;!!!!/>H:  #|              IH&*I#/;;,,,,:::::::
 106 ::::::,,,,,,,,,;;;;;!!!!!!!!!!//>|.H:                     #I>!!;;,,,,::::::
 107 :::,,,,,,,,,;;;;!/||>///>>///>>)|H                         %|&/;;,,,,,:::::
 108 :,,,,,,,,;;;;;!!//)& :;I*,H#&||&/                           *)/!;;,,,,,::::
 109 ,,,,,,;;;;;!!!//>)IH:,        ##                            #&!!;;,,,,,::::
 110 ,;;;;!!!!!///>)H%.**           *                            )/!;;;,,,,,::::
 111                                                           &)/!!;;;,,,,,::::
 112 ,;;;;!!!!!///>)H%.**           *                            )/!;;;,,,,,::::
 113 ,,,,,,;;;;;!!!//>)IH:,        ##                            #&!!;;,,,,,::::
 114 :,,,,,,,,;;;;;!!//)& :;I*,H#&||&/                           *)/!;;,,,,,::::
 115 :::,,,,,,,,,;;;;!/||>///>>///>>)|H                         %|&/;;,,,,,:::::
 116 ::::::,,,,,,,,,;;;;;!!!!!!!!!!//>|.H:                     #I>!!;;,,,,::::::
 117 ::::::::::,,,,,,,,,,;;;;;;;;;!!!!/>H:  #|              IH&*I#/;;,,,,:::::::
 118 :::::::::::::::,,,,,,,,,,;;;;;;;!!/>>I>>)||I#     H&))>////*!;;,,,,::::::::
 119 ::::::::::::::::::,,,,,,,,,,,,;;;;;;!!!!//>|:    !:|//!!;;;;;,,,,,:::::::::
 120 ::::::::::::::::::::::,,,,,,,,,,,,,;;;;;!!//)|.*#|>/!;;;;;,,,,,,:::::::::::
 121 :::::::::::::::::::::::::,,,,,,,,,,,,,;;;;!!/>&*|& !;;;,,,,,,,:::::::::::::
 122 ...::::::::::::::::::::::::::,,,,,,,,,,,,;;;!:H!!;;;,,,,,,,,:::::::::::::..
 123 .....:::::::::::::::::::::::::::::,,,,,,,,,,,,,,,,,,,,,,:::::::::::::::....
 124 ........::::::::::::::::::::::::::::::::::,,,,,,,:::::::::::::::::::.......
 125 ...........::::::::::::::::::::::::::::::::::::::::::::::::::::::..........
 126 END_EXPECTED
 127
 128     'substr.pir' => << 'END_EXPECTED',
 129
 130 H
 131 He
 132 Hel
 133 Hell
 134 Hello
 135 Hello
 136 Hello W
 137 Hello Wo
 138 Hello Wor
 139 Hello Worl
 140 Hello World
 141 Hello Worl
 142 Hello Wor
 143 Hello Wo
 144 Hello W
 145 Hello
 146 Hello
 147 Hell
 148 Hel
 149 He
 150 H
 151
 152 END_EXPECTED
 153
 154     'sudoku.pir' => << 'END_EXPECTED',
 155 +---------+---------+---------+
 156 | 1  .  . | .  .  . | .  .  . |
 157 | .  .  2 | 7  4  . | .  .  . |
 158 | .  .  . | 5  .  . | .  .  4 |
 159 +---------+---------+---------+
 160 | .  3  . | .  .  . | .  .  . |
 161 | 7  5  . | .  .  . | .  .  . |
 162 | .  .  . | .  .  9 | 6  .  . |
 163 +---------+---------+---------+
 164 | .  4  . | .  .  6 | .  .  . |
 165 | .  .  . | .  .  . | .  7  1 |
 166 | .  .  . | .  .  1 | .  3  . |
 167 +---------+---------+---------+
 168 init ok
 169 +---------+---------+---------+
 170 | 1  8  4 | 9  6  3 | 7  2  5 |
 171 | 5  6  2 | 7  4  8 | 3  1  9 |
 172 | 3  9  7 | 5  1  2 | 8  6  4 |
 173 +---------+---------+---------+
 174 | 2  3  9 | 6  5  7 | 1  4  8 |
 175 | 7  5  6 | 1  8  4 | 2  9  3 |
 176 | 4  1  8 | 2  3  9 | 6  5  7 |
 177 +---------+---------+---------+
 178 | 9  4  1 | 3  7  6 | 5  8  2 |
 179 | 6  2  3 | 8  9  5 | 4  7  1 |
 180 | 8  7  5 | 4  2  1 | 9  3  6 |
 181 +---------+---------+---------+
 182 solved
 183 END_EXPECTED
 184 );
 185
 186 # expected output of a quine is the quine itself
 187 $expected{'quine_ord.pir'} = Parrot::Test::slurp_file("examples/pir/quine_ord.pir");
 188
 189 my %skips;
 190
 191 while ( my ( $example, $expected ) = each %expected ) {
 192     my $skip = $skips{$example};
 193     if ($skip) {
 194         my ( $cond, $reason ) = @{$skip};
 195         if ( eval "$cond" ) {
 196             Test::More->builder->skip("$example $reason");
 197             next;
 198         }
 199     }
 200     example_output_is( "examples/pir/$example", $expected );
 201 }
 202
 203 my $PARROT = ".$PConfig{slash}$PConfig{test_prog}";
 204
 205 # For testing life.pir, the number of generations should be small,
 206 # because users should not get bored.
 207 {
 208     my $life_fn = "examples$PConfig{slash}pir$PConfig{slash}life.pir";
 209     my $sum     = `$PARROT $life_fn 4`;
 210     like( $sum, qr/4 generations in/, 'life ran for 4 generations' );
 211 }
 212
 213 # readline.pir expects something on standard input
 214 {
 215     my $readline_pir_fn = "examples$PConfig{slash}pir$PConfig{slash}readline.pir";
 216     my $readline_tmp_fn = "test_readline.tmp";
 217     open( my $tmp, '>', $readline_tmp_fn );
 218     print $tmp join( "\n", 'first line', '', 'last line' );
 219     close $tmp;
 220     my $out = `$PARROT $readline_pir_fn < $readline_tmp_fn`;
 221     is( $out, << 'END_EXPECTED', 'print until first empty line' );
 222 first line
 223 END_EXPECTED
 224     unlink($readline_tmp_fn);
 225 }
 226
 227 # uniq.pir expects a file that it can uniquify
 228 {
 229     my $uniq_pir_fn = "examples$PConfig{slash}pir$PConfig{slash}uniq.pir";
 230     my $uniq_tmp_fn = "test_uniq.tmp";
 231     open( my $tmp, '>', $uniq_tmp_fn );
 232     print $tmp join( "\n", qw( a a a b b c d d d ) );
 233     print $tmp "\n";
 234     close $tmp;
 235
 236     my $out = `$PARROT $uniq_pir_fn $uniq_tmp_fn`;
 237     is( $out, << 'END_EXPECTED', 'uniq' );
 238 a
 239 b
 240 c
 241 d
 242 END_EXPECTED
 243
 244     $out = `$PARROT $uniq_pir_fn -c $uniq_tmp_fn`;
 245     is( $out, << 'END_EXPECTED', 'uniq -c' );
 246       3 a
 247       2 b
 248       1 c
 249       3 d
 250 END_EXPECTED
 251
 252     $out = `$PARROT $uniq_pir_fn -d $uniq_tmp_fn`;
 253     is( $out, << 'END_EXPECTED', 'uniq -d' );
 254 a
 255 b
 256 d
 257 END_EXPECTED
 258
 259     $out = `$PARROT $uniq_pir_fn -u $uniq_tmp_fn`;
 260     is( $out, << 'END_EXPECTED', 'uniq -u' );
 261 c
 262 END_EXPECTED
 263
 264     unlink($uniq_tmp_fn);
 265 }
 266
 267 ## Added test this way, so we can have more interesting tests.
 268 pir_output_is( <<'CODE', <<OUTPUT, "Test Levenshtein example" );
 269 .include "examples/pir/levenshtein.pir"
 270 .sub main :main
 271         $S1 = "purl"
 272         $S2 = "perl"
 273         $I1 = levenshtein($S1,$S2)
 274         print $I1
 275         print "\n"
 276
 277         $S1 = "parrot"
 278         $S2 = "perl"
 279         $I1 = levenshtein($S1,$S2)
 280         print $I1
 281         print "\n"
 282
 283         $S1 = "perl"
 284         $S2 = "perl"
 285         $I1 = levenshtein($S1,$S2)
 286         print $I1
 287         print "\n"
 288
 289         $S1 = "perler"
 290         $S2 = "perl"
 291         $I1 = levenshtein($S1,$S2)
 292         print $I1
 293         print "\n"
 294
 295         end
 296 .end
 297 CODE
 298 1
 299 4
 300 0
 301 2
 302 OUTPUT
 303
 304 TODO:
 305 {
 306     local $TODO = 'some examples not testable yet';
 307
 308     fail('queens_r.pir');
 309     fail('thr_primes.pir');
 310 }
 311
 312 # Local Variables:
 313 #   mode: cperl
 314 #   cperl-indent-level: 4
 315 #   fill-column: 100
 316 # End:
 317 # vim: expandtab shiftwidth=4: