#!perl
# Copyright (C) 2005-2006, The Perl Foundation.
# $Id: pir.t 23230 2007-11-29 04:03:22Z coke $

use strict;
use warnings;
use lib qw( . lib ../lib ../../lib );

use Test::More;
use Parrot::Test tests => 19;
use Parrot::Config;

=head1 NAME

t/examples/pir.t - Test examples in F<examples/pir>

=head1 SYNOPSIS

    % prove t/examples/pir.t

=head1 DESCRIPTION

Test the examples in F<examples/pir>.

=head1 SEE ALSO

F<t/examples/pasm.t>

=head1 AUTHOR

Bernhard Schmalhofer - <Bernhard.Schmalhofer@gmx.de>

=cut

# 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
END_EXPECTED
);

# expected output of a quine is the quine itself
$expected{'quine_ord.pir'} = Parrot::Test::slurp_file("examples/pir/quine_ord.pir");

my %skips;

while ( my ( $example, $expected ) = each %expected ) {
    my $skip = $skips{$example};
    if ($skip) {
        my ( $cond, $reason ) = @{$skip};
        if ( eval "$cond" ) {
            Test::More->builder->skip("$example $reason");
            next;
        }
    }
    example_output_is( "examples/pir/$example", $expected );
}

my $PARROT = ".$PConfig{slash}$PConfig{test_prog}";

# 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 join( "\n", 'first line', '', 'last line' );
    close $tmp;
    my $out = `$PARROT $readline_pir_fn < $readline_tmp_fn`;
    is( $out, << 'END_EXPECTED', 'print until first empty line' );
first line
END_EXPECTED
    unlink($readline_tmp_fn);
}

# uniq.pir expects a file that it can uniquify
{
    my $uniq_pir_fn = "examples$PConfig{slash}pir$PConfig{slash}uniq.pir";
    my $uniq_tmp_fn = "test_uniq.tmp";
    open( my $tmp, '>', $uniq_tmp_fn );
    print $tmp join( "\n", qw( a a a b b c d d d ) );
    print $tmp "\n";
    close $tmp;

    my $out = `$PARROT $uniq_pir_fn $uniq_tmp_fn`;
    is( $out, << 'END_EXPECTED', 'uniq' );
a
b
c
d
END_EXPECTED

    $out = `$PARROT $uniq_pir_fn -c $uniq_tmp_fn`;
    is( $out, << 'END_EXPECTED', 'uniq -c' );
      3 a
      2 b
      1 c
      3 d
END_EXPECTED

    $out = `$PARROT $uniq_pir_fn -d $uniq_tmp_fn`;
    is( $out, << 'END_EXPECTED', 'uniq -d' );
a
b
d
END_EXPECTED

    $out = `$PARROT $uniq_pir_fn -u $uniq_tmp_fn`;
    is( $out, << 'END_EXPECTED', 'uniq -u' );
c
END_EXPECTED

    unlink($uniq_tmp_fn);
}

## Added test this way, so we can have more interesting tests.
pir_output_is( <<'CODE', <<OUTPUT, "Test Levenshtein example" );
.include "../../examples/pir/levenshtein.pir"
.sub main :main
        $S1 = "purl"
        $S2 = "perl"
        $I1 = levenshtein($S1,$S2)
        print $I1
        print "\n"

        $S1 = "parrot"
        $S2 = "perl"
        $I1 = levenshtein($S1,$S2)
        print $I1
        print "\n"

        $S1 = "perl"
        $S2 = "perl"
        $I1 = levenshtein($S1,$S2)
        print $I1
        print "\n"

        $S1 = "perler"
        $S2 = "perl"
        $I1 = levenshtein($S1,$S2)
        print $I1
        print "\n"

        end
.end
CODE
1
4
0
2
OUTPUT

TODO:
{
    local $TODO = 'some examples not testable yet';

    fail('hello-dwim.pir');
    fail('queens_r.pir');
    fail('thr_primes.pir');
}

# Local Variables:
#   mode: cperl
#   cperl-indent-level: 4
#   fill-column: 100
# End:
# vim: expandtab shiftwidth=4: