t/configure/033-step.t

   1 #!perl
   2 # Copyright (C) 2001-2005, Parrot Foundation.
   3 # $Id$
   4
   5 use strict;
   6 use warnings;
   7
   8 use Test::More tests => 31;
   9 use Carp;
  10 use Cwd;
  11 use File::Basename qw(basename dirname);
  12 use File::Temp 0.13 qw/ tempfile /;
  13 use File::Spec;
  14 use lib qw( lib t/configure/testlib );
  15 use IO::CaptureOutput qw | capture |;
  16 use Tie::Filehandle::Preempt::Stdin;
  17
  18 BEGIN { use Parrot::Configure::Utils; }
  19
  20 Parrot::Configure::Utils->import(@Parrot::Configure::Utils::EXPORT_OK);
  21 can_ok( __PACKAGE__, @Parrot::Configure::Utils::EXPORT_OK );
  22
  23 my $cwd = cwd();
  24 my ( @prompts, $object, $cc, $nonexistent, $command );
  25
  26 # integrate()
  27
  28 is( integrate( undef, undef ), undef, "integrate(undef, undef)" );
  29 is( integrate( undef, 1 ),     1,     "integrate(undef, 1)" );
  30 is( integrate( 1,     undef ), 1,     "integrate(1, undef)" );
  31 is( integrate( 1,     2 ),     2,     "integrate(1, 1)" );
  32 is( integrate( 1,     q{ } ),  1,     'integrate(1, [empty string])' );
  33
  34 # prompt()
  35 # Tests in t/configure/1??-inter-*.t do a good job of testing prompt().
  36 # They leave only one condition to be tested here.
  37
  38 @prompts = (q{});
  39 $object = tie *STDIN, 'Tie::Filehandle::Preempt::Stdin', @prompts;
  40 can_ok( 'Tie::Filehandle::Preempt::Stdin', ('READLINE') );
  41 isa_ok( $object, 'Tie::Filehandle::Preempt::Stdin' );
  42 $cc = q{gcc-3.3};
  43 {
  44     my $rv;
  45     my $stdout;
  46        capture ( sub { $rv = prompt( "What C compiler do you want to use?", $cc ) },
  47            \$stdout );
  48     ok( $stdout, "prompts were captured" );
  49     is( $rv, $cc, "Empty response to prompt led to expected return value" );
  50 }
  51 $object = undef;
  52 untie *STDIN;
  53
  54 # file_checksum(), not exported
  55
  56 $nonexistent = $$;
  57 eval { my $sum = Parrot::Configure::Utils::file_checksum($nonexistent); };
  58 like(
  59     $@, qr/Can't open $nonexistent/,    #'
  60     "Got expected error message when trying to get checksum on non-existent file"
  61 );
  62
  63 {
  64     my ( $tmpfile, $fname ) = tempfile( UNLINK => 1 );
  65     print $tmpfile "foo" x 1000;
  66     $tmpfile->flush;
  67     is( Parrot::Configure::Utils::file_checksum($fname),
  68         '324000', "file_checksum() returns correct checksum" );
  69 }
  70
  71 {
  72     my ( $tmpfile, $fname ) = tempfile( UNLINK => 1 );
  73     my $str = 'Do not print this line';
  74     print $tmpfile "foo" x 500;
  75     print $tmpfile "\n";
  76     print $tmpfile "$str\n";
  77     print $tmpfile "foo" x 500;
  78     $tmpfile->flush;
  79     my $ignore_pattern = qr/$str/;
  80     my $csum = Parrot::Configure::Utils::file_checksum( $fname, $ignore_pattern );
  81     is( $csum, '324010', "file_checksum() returns correct checksum" );
  82 }
  83
  84 # copy_if_diff()
  85
  86 {
  87     my ( $fromfile, $fromfname ) = tempfile( UNLINK => 1 );
  88     my ( $tofile,   $tofname )   = tempfile( UNLINK => 1 );
  89     print $fromfile "foo" x 1000;
  90     $fromfile->flush;
  91
  92     ok( copy_if_diff( $fromfname, $tofname ), "copy_if_diff() true return status" );
  93     is( Parrot::Configure::Utils::file_checksum($tofname),
  94         '324000', "copy_if_diff() copied differing files" );
  95 }
  96
  97 {
  98     my ( $fromfile, $fromfname ) = tempfile( UNLINK => 1 );
  99     my ( $tofile,   $tofname )   = tempfile( UNLINK => 1 );
 100     print $fromfile "foo" x 1000;
 101     $fromfile->flush;
 102     print $tofile "foo" x 1000;
 103     $tofile->flush;
 104
 105     ok( !defined( copy_if_diff( $fromfname, $tofname ) ), "copy_if_diff() true return undef" );
 106 }
 107
 108 # move_if_diff()
 109
 110 {
 111     my ( $fromfile, $fromfname ) = tempfile( UNLINK => 1 );
 112     my ( $tofile,   $tofname )   = tempfile( UNLINK => 1 );
 113     print $fromfile "foo" x 1000;
 114     $fromfile->close;
 115     $tofile->close;
 116
 117     # redirect STDERR to avoid warnings
 118     my $redir = File::Spec->devnull;
 119
 120     # copy file descriptors
 121     open *OLDERR, ">&", "STDERR";
 122     $fromfile->close();
 123     $tofile->close();
 124
 125     ok( move_if_diff( $fromfname, $tofname ), "move_if_diff() true return status" );
 126     ok( !-e $fromfname, "move_if_diff() moved differing file" );
 127
 128     # redirect STDERR for the test below
 129     close *STDERR;
 130     open *STDERR, '<', $redir;
 131
 132     ok( -e $tofname, "move_if_diff() moved differing file" );
 133
 134     # restore STDERR
 135     close *STDERR;
 136     open *STDERR, ">&", "OLDERR";
 137     close *OLDERR;
 138 }
 139
 140 {
 141     my %tf_params = ( UNLINK => 1, );
 142     $tf_params{SUFFIX} = '.exe' if (
 143         ( $^O eq 'MSWin32' ) ||
 144         ( $^O eq 'cygwin'  )
 145     );
 146     my ( $tmpfile, $fname ) = tempfile(%tf_params);
 147
 148     local $ENV{PATH} = dirname($fname);
 149     chmod 0777, $fname;
 150     my $prog = basename($fname);
 151
 152     is( check_progs($prog), $prog, "check_progs() returns the proper program" )
 153 }
 154
 155 {
 156     my %tf_params = ( UNLINK => 1, );
 157     $tf_params{SUFFIX} = '.exe' if (
 158         ( $^O eq 'MSWin32' ) ||
 159         ( $^O eq 'cygwin'  )
 160     );
 161     my ( $tmpfile, $fname ) = tempfile(%tf_params);
 162
 163     local $ENV{PATH} = dirname($fname);
 164     chmod 0777, $fname;
 165     my $prog = basename($fname);
 166
 167     is( check_progs( [$prog] ),
 168         $prog, "check_progs() returns the proper program when passed an array ref" )
 169 }
 170
 171 {
 172     my $cmd = 'someboguscommand';
 173     ok( !check_progs( [$cmd] ), "check_progs() returns undef in scalar context on failure" );
 174     ok( !check_progs($cmd), "check_progs() returns undef in scalar context on failure" );
 175     is_deeply( [ check_progs( [$cmd] ) ],
 176         [], "check_progs() returns () in list context on failure" );
 177     is_deeply( [ check_progs($cmd) ], [], "check_progs() returns () in list context on failure" );
 178 }
 179
 180 {
 181     my %tf_params = ( UNLINK => 1, );
 182     $tf_params{SUFFIX} = '.exe' if (
 183         ( $^O eq 'MSWin32' ) ||
 184         ( $^O eq 'cygwin'  )
 185     );
 186     my ( $tmpfile, $fname ) = tempfile(%tf_params);
 187
 188     local $ENV{PATH} = dirname($fname);
 189     chmod 0777, $fname;
 190     my $prog = basename($fname);
 191
 192     my $verbose = 1;
 193     my $stdout;
 194     capture ( sub { is( check_progs( $prog, $verbose ),
 195                 $prog, "check_progs() returns the proper program" ) }, \$stdout );
 196     like( $stdout, qr/checking for program/, "Got expected verbose output" );
 197 }
 198
 199 {
 200     my $verbose = 1;
 201     my $stdout;
 202     my $prog ;
 203     capture ( sub { $prog = check_progs(
 204              [ 'gmake', 'mingw32-make', 'nmake', 'make' ], $verbose) }, \$stdout );
 205     ok( defined($prog), "check_progs() returned a 'make' program" );
 206     like( $stdout, qr/checking for program/s, "Got expected verbose output" );
 207     like( $stdout, qr/$prog(\.EXE)? is executable/s,
 208         "Got expected verbose output for executable program" );
 209 }
 210
 211 # _slurp(), not exported
 212
 213 {
 214     my ( $tmpfile, $fname ) = tempfile( UNLINK => 1 );
 215     print $tmpfile "foo" x 1000;
 216     $tmpfile->flush;
 217     is( Parrot::Configure::Utils::_slurp($fname), "foo" x 1000, "_slurp() slurped the file" );
 218 }
 219
 220 ################### DOCUMENTATION ###################
 221
 222 =head1 NAME
 223
 224 t/configure/033-step.t - tests Parrot::Configure::Utils
 225
 226 =head1 SYNOPSIS
 227
 228     prove t/configure/033-step.t
 229
 230 =head1 DESCRIPTION
 231
 232 Regression tests for the L<Parrot::Configure::Utils> module.
 233
 234 =cut
 235
 236 # Local Variables:
 237 #   mode: cperl
 238 #   cperl-indent-level: 4
 239 #   fill-column: 100
 240 # End:
 241 # vim: expandtab shiftwidth=4: