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