-------------------------
$ make realclean && perl Makefile.PL && make && make test
-------------------------
$ ./Build realclean && perl Build.PL && perl ./Build && perl ./Build test
-------------------------
#!/bin/bash

 if [ -f Build.PL ]; then
     makeprog=Build
     makecommand="perl ./Build"
 elif [ -f Makefile.PL ]; then
     makeprog=Makefile
     makecommand=make
 else
     echo Nothing to reload!
     exit 1
 fi

 if [ -f $makeprog ]; then
     $makecommand realclean
 fi
 perl $makeprog.PL && $makecommand && $makecommand test
-------------------------
 if [ "$1" = dist ]; then
     $makecommand dist
 fi
-------------------------
  # aduje i aktywuje modu LectroTest
 use Test::LectroTest;

 Property
 {
     ##[ x <- Float ]##                                        # pierwszy krok
     sqrt( $x * $x ) == $x;                                    # drugi krok
 }, name => "sqrt jest odwrotnoci podnoszenia do kwadratu";  # trzeci krok
-------------------------
 1..1
 not ok 1 - 'sqrt jest odwrotnoci podnoszenia do kwadratu' falsified in 3 attempts
 # Kontrprzykad:
 # $x = "-1.61625080606365";
-------------------------
 # pomoc: zwraca true, jeli wywoanie danej funkcji  
 # koczy si bdem; w przeciwnym wypadku zwraca false 

 sub gives_error(&)
 {
     ! eval { shift->(  ) } and $@ ne "";
 }

 Property
 {
     ##[ x <- Float ]##
     $x < 0 ? gives_error { sqrt( $x ) }
            : sqrt( $x * $x ) =  = $x
 }, name => "sqrt jest odwrotnoci podnoszenia do kwadratu, die dla liczb ujemnych";
-------------------------
Property
 {
     ##[ x <- Float ]##
     $tcon->retry(  ) if $x < 0;      # testuje tylko liczby nieujemne
     sqrt( $x * $x ) =  = $x;
 }, name => "sqrt jest odwrotnoci podnoszenia do kwadratu";

 Property
 {
     ##[ x <- Float ]##
     $tcon->retry(  ) unless $x < 0;  # testuje tylko liczby ujemne
     gives_error { sqrt( $x ) };
 }, name => "sqrt z liczby ujemnej zwraca bd";
-------------------------
 1..2
 ok 1 - ' sqrt jest odwrotnoci podnoszenia do kwadratu' (1000 attempts)
 ok 2 - ' sqrt z liczby ujemnej zwraca bd' (1000 attempts)
-------------------------
package Module::Build::FilterTests;

 use base 'Module::Build';

 use SUPER;
 use File::Spec::Functions;

 sub ACTION_disttest
 {
     local $ENV{PERL_RUN_ALL_TESTS} = 1;
     super(  );
 }

 sub find_test_files
 {
     my $self  = shift;
     my $tests = super(  );

     return $tests unless $ENV{PERL_RUN_ALL_TESTS};

     my $test_pattern = catfile(qw( t developer *.t ) );
     push @$tests, <$test_pattern>;
     return $tests;
 }

 1;
-------------------------
 $ perl Build.PL
 Checking whether your kit is complete...
 Looks good
 Deleting Build
 Removed previous script 'Build'
 Creating new 'Build' script for 'SomeModule' version '1.28'
 $ perl ./Build
 $ perl ./Build test
 ... user tests run ...
-------------------------
#!/usr/bin/perl

 # polecenie onchange plik1 plik2 ... plikN 

 use strict;
 use warnings;

 use File::Find;
 use Digest::MD5;

 my $Command     = pop @ARGV;
 my $Files       = [@ARGV];
 my $Last_digest = '';

 sub has_changed
 {
     my $files = shift;
     my $ctx   = Digest::MD5->new(  );

     find( sub { $ctx->add( $File::Find::name, ( stat($_) )[9] ) },
         grep { -e $_ } @$files );

     my $digest      = $ctx->digest(  );
     my $has_changed = $digest ne $Last_digest;
     $Last_digest    = $digest;

     return $has_changed;
 }

 while (1)
 {
     system( $Command ) if has_changed( $Files );
     sleep 1;
 }
-------------------------
$ onchange Build.PL lib t 'clear; ./Build test'
-------------------------
 #!/usr/bin/perl

 use strict;
 use warnings;

 use IPC::Open3;
 use Term::ANSIColor;
 use Test::Harness::Straps;

 my $strap = Test::Harness::Straps->new(  );

 for my $file (@ARGV)
 {
     next unless -f $file;

     my $output;

     my $command = $strap->_command_line( $file );
     my $pid     = open3( undef, $output, $output, $command );
     my %results = $strap->analyze( $file, $output );

     print $_->{output} for @{ process_results( $file, \%results ) };
 }

 sub process_results
 {
     my ( $file, $results ) = @_;
     my $count              = 0;

     my @results;
     for my $test ( @{ $results->{details} } )
     {
         $count++;
         next if $test->{ok};

         push @results =>
         {
             test   => $test,
             output => create_test_result(
                 $test->{ok}, $count, @{$test}{qw( name reason diagnostics )}
             )
         };
     }

     return \@results;
 }

 sub create_test_result
 {
     my ( $ok, $number, $name, $reason, $diag ) = @_;

     $ok       = $ok ? 'ok' : 'not ok';
     $reason ||= '';
     $reason   = " ($reason)" if $reason;
     $diag   ||= '';

     return color( 'bold red' ) .
            sprintf "%6s %4d %s%s\n%s\n", $ok, $number, $name, $reason,
            color( 'clear yellow' ) . $diag . color( 'reset' );
 }
-------------------------
 package UserFactory;

 use User;
 use UserProxy;

 my $count    = 0;

 sub create
 {
    my $self  = shift;
    my $class = $count++ % 100 ? 'User' : 'UserProxy';
    return $class->new( id => $count, @_ );
 }

 1;
-------------------------
 package UserProxy;

 use strict;
 use warnings;

 use User;
 use Test::Builder;

 sub new
 {
     my ($class, %args) = @_;
     my $proxied        = User->new( %args );
     my $Test           = Test::Builder->create(  );
     $Test->output( time(  ) . '_' . $proxied->id(  ) . '.tap' );
     $Test->plan( 'no_plan' );
     bless { proxied => $proxied, test => $Test }, $class;
 }

 sub proxied
 {
     my $self = shift;
     return $self->{proxied};
 }

 sub test
 {
     my $self = shift;
     return $self->{test};
 }

 sub can
 {
     my ($self, $method) = @_;
     my $proxied         = $self->proxied(  );
     return $proxied->can( $method );
 }

 sub verify_name
 {
     my ($self, $name)   = @_;
     my $proxied         = $self->proxied(  ):
     my $test            = $self->test(  );
     $test->ok( $proxied->verify_name( $name ), "verify_name(  ) for '$name'" )
         || $test->diag( $proxied->verification_error(  ) );
 }

 # ...

 1;
-------------------------
 use strict;
 use warnings;

 no warnings 'recursion';

 sub ackermann
 {
     my ($m, $n) = @_;
     return            $n + 1      if $m =  = 0;
     return ackermann( $m - 1, 1 ) if $n =  = 0;
     return ackermann( $m - 1, ackermann( $m, $n - 1 ) );
 }

 print ackermann( 3, 10 ), "\n";
-------------------------
 use Memoize;
 memoize( 'ackermann' );
-------------------------
$ sh Configure -h
-------------------------
$ make
-------------------------
$ make test
-------------------------
$ ./perlbug -nok
-------------------------
$ ./perlbug -nok -f build.failure
-------------------------
$ make install
-------------------------
 package Test::PerPerlHelper;

 use strict;
 use warnings;

 use base 'Test::Builder';

 require Test::More;

 sub import
 {
     my $class = shift;

     if (eval {require PersistentPerl} && PersistentPerl->i_am_perperl(  ))
     {
         # ponownie bogosawimy singletonowy obiekt Test::Builder w nasz klas,
         # dziki czemu moemy pokry plan i metody _dup_stdhandles 
         my $Test = Test::Builder->new(  );
         bless $Test, _ _PACKAGE_ _;
     }

     $class->plan(@_);
 }

 sub plan
 {
     my $class = shift;
     return unless @_;

     my $Test  = Test::Builder->new(  );

     if (eval {require PersistentPerl} && PersistentPerl->i_am_perperl(  ))
     {
         $Test->reset(  );

         Test::Builder::_autoflush(*STDOUT);
         Test::Builder::_autoflush(*STDERR);

         $Test->output(*STDOUT);
         $Test->failure_output(*STDERR);
         $Test->todo_output(*STDOUT);

         $Test->no_ending(1);
         my $pp   = PersistentPerl->new(  );
         $pp->register_cleanup(sub { $Test->_ending });
     }
     $Test->SUPER::plan(@_);
 }

 # Duplikacja STDERR i STDOUT nie dziaa pod perperl
 # tak wiec pokrywamy j za pomoc metody bez operatorw 
 sub _dup_stdhandles {  }

 1;
-------------------------
use Test::More 'no_plan';

 ok(1);
 ok(2);
 ok(3);

 1;  # testy wykonywane w sposb trway musz si koczy wartoci true!
-------------------------
 #!/usr/bin/perperl -- -M1

 use strict;
 use Test::PerPerlHelper;

 my $script;
 while (my $arg = shift)
 {
     # jeli argumentem arg jest opcja -I, dodajemy katalog do zmiennej @INC
     # chyba, e ju tam taki jest
     if ($arg =~ /^-I(.*)/ and -d $1)
     {
         unshift @INC, $1 unless grep { $_ eq $1 } @INC;
     }
     else
     {
         $script = $arg;
     }
 }

 do $script or die $@;
-------------------------
$ HARNESS_PERL=perperl-runscript prove -Ilib t/
-------------------------
 #!/bin/sh

 export HARNESS_PERL=perperl-runscript

 prove $*
-------------------------
 $ perperl-prove -Ilib t/
 $ prove -Ilib t/
-------------------------
$ killall perperl_backend
-------------------------
 use Test::More;
 use Test::PerPerlHelper;
 if (eval { require PersistentPerl } and PersistentPerl->i_am_perperl(  ) )
 {
     Test::PerPerlHelper->plan(
         'skip_all',
         'Przekierowywanie STDIN nie dziaa pod perperl' );
 }
 else
 {
     plan "no_plan";
 }
-------------------------
 use Module::Reloader;
 Module::Reloader::reload(  ) if $ENV{'RELOAD_MODULES'};
-------------------------
$ RELOAD_MODULES=1 perperl-prove t/
-------------------------
$ perperl-prove t/
-------------------------
 my $builder = Module::Build->new(
   # ... inne opcje pliku Build.PL ...
   requires =>
   {
       'Test::More'       => 0,
       'CGI'              => 2.0,
   }
 );
-------------------------
 WriteMakefile(
     # ... inne opcje pliku Makefile.PL ...
     'PREREQ_PM' =>
     {
         'Test::More'     => 0,
         'CGI'            => 2.0,
     }
 );
-------------------------
use Test::More;
 use CGI;

 if ($CGI->VERSION >= 3.11)
 {
     plan skip_all => 'pomijam testy kompatybilnoci dla starego pakietu CGI.pm';
 }
 else
 {
     plan 'tests' => 17;
 }
-------------------------
 eval 'require URI;';
 if ($@)
 {
     plan skip_all => 'opcjonalny modu URI nie jest zainstalowany';
 }
 else
 {
     plan 'tests' => 10;
 }
-------------------------
 $ mkdir t/prereq_lib
 $ mkdir t/prereq_lib/CGI
 $ cp CGI-3.10.pm t/prereq_lib/CGI.pm
 $ prove -Ilib -It/prereq_lib t/
-------------------------
 1;
 666;
 "false";
 "Steve Peters, Master Of True Value Finding, was here.";
-------------------------
 $ mkdir -p t/skip_lib
 $ touch t/skip_lib/URI.pm
 $ prove -Ilib -It/skip_lib t/
-------------------------
 $ mkdir -p t/mieszane_scenariusze/brak_uri
 $ touch t/mieszane_scenariusze/brak_uri/URI.pm
 $ mkdir -p t/mieszane_scenariusze/stary_cgi
 $ cp CGI-3.10.pm t/mieszane_scenariusze/stary_cgi/CGI.pm
 $ mkdir -p t/mieszane_scenariusze/nowy_cgi	
 $ cp CGI-3.15.pm t/mieszane_scenariusze/nowy_cgi/CGI.pm
-------------------------
$ for lib in t/mieszane_scenariusze/*; do prove -Ilib -I$lib t/; done
-------------------------
  #!/usr/bin/perl

 use strict;
 use File::Find;

 if (@ARGV < 2)
 {
     die "Skadnia: $0 [katalog_mieszanych_scenariuszy] [argumenty dla prove]\n";
 }

 my $scenarios_dir = shift;

 my %scenario_modules;
 my $errors;

 my @scenarios     = grep { -d } <$scenarios_dir/*>;

 for my $lib_dir (@scenarios)
 {
     unless (-d $lib_dir)
     {
         $errors   = 1;
         warn "nie istnieje katalog biblioteki: $lib_dir\n";
         next;
     }
     my @modules;

     find(sub
     {
         return unless -f;

         my $dir =  "$File::Find::dir/$_";
         $dir    =~ s/^\Q$lib_dir\E//;
         $dir    =~ s/\.pm$//;
         $dir    =~ s{^/}{  };
         $dir    =~ s{/}{::}g;

         push @modules, $dir;
     }, $lib_dir);

     $scenario_modules{$lib_dir} = \@modules;
 }

 die "Kocz dziaanie." if $errors;

 for my $lib_dir (@scenarios)
 {
     my $modules   = join ', ', sort @{ $scenario_modules{$lib_dir} };
     $modules    ||= 'none';
     print "\n" . '#' x 62 . "\n";
     print "Uruchamiam testy. W tym scenariuszu stare (lub nieobecne) moduy:\n";
     print "$modules\n";

     my @prove_command = ('prove', "-I$lib_dir", @ARGV);

     system( @prove_command ) && do
     {
         die <<EOF;
 ##############################################################
 Jeden lub wicej testw zakoczyo si niepowodzeniem dla scenariusza $lib_dir.
 Przestarzae lub nieobecne moduy:
     $modules

 Polecenie miao posta:
     @prove_command

 Kocz prac.
 ##############################################################
 EOF
     };
 }
-------------------------
$ prove-prereqs t/prereq_scenarios -Ilib t/
-------------------------





