Ticket #401: r34567-tt97-test-installables.diff

File r34567-tt97-test-installables.diff, 3.9 KB (added by rurban, 4 years ago)

  • t/tools/parrot_config.t 

    r34567 | rurban++ | branches/pdd30install_stage3/t/tools: 
12:52  : Trac #97: Current tests do not test the installables, esp. 
12:52  : if the prefix is correctly set from the build_dir to the 
12:52  : configured prefix, i.e. if config.fpmc is linked, in contrary 
12:52  : to the build-time config_lib.pasm 
12:52  : t/tools/parrot_config.t checks parrot_config prefix against 
12:52  : installable_parrot_config prefix. 
12:52  review: http://www.parrotvm.org/svn/pa[
]evision?rev=34567
     
     1#! perl 
     2# Copyright (C) 2008, The Perl Foundation. 
     3# $Id: parrot_config.t 30553 2008-08-26 01:31:47Z chromatic $ 
     4 
     5=head1 NAME 
     6 
     7t/tools/parrot_config.t - test parrot_config and installable-parrot_config 
     8 
     9=head1 SYNOPSIS 
     10 
     11    % prove t/tools/parrot_config.t 
     12 
     13=head1 DESCRIPTION 
     14 
     15Tests the C<parrot_config> and C<installable_parrot_config> tools by 
     16comparing some options to the config hash. Esp. the installable logic. 
     17 
     18=head1 REQUIREMENTS 
     19 
     20This test script requires you to build parrot_config and the installables, 
     21by using "make parrot_utils" and "make installables" (using a suitable 
     22make tool for your platform). 
     23If this requirement has not been met, some tests will be skipped. 
     24 
     25=cut 
     26 
     27use strict; 
     28use warnings; 
     29use lib qw(lib); 
     30 
     31use Test::More; 
     32use IO::File; 
     33use Parrot::Config; 
     34use File::Spec; 
     35 
     36my ($path_to_cfg, $path_to_parrot, $builddir); 
     37 
     38BEGIN { 
     39    $builddir = $PConfig{build_dir}; 
     40    $path_to_cfg = File::Spec->catfile( $builddir, "parrot_config"); 
     41    $path_to_parrot = File::Spec->catfile( $builddir, "parrot" . $PConfig{exe}); 
     42    unless ( -f $path_to_parrot ) { 
     43        plan skip_all => "parrot hasn't been built. Run make"; 
     44        exit(0); 
     45    } 
     46    my $exefile = $path_to_cfg . $PConfig{exe}; 
     47    unless ( -f $exefile ) { 
     48        plan skip_all => "parrot_config hasn't been built. Run make parrot_utils"; 
     49        exit(0); 
     50    } 
     51    plan tests => 5; 
     52} 
     53 
     54my $tests = 0; 
     55my $prefix = $PConfig{prefix}; 
     56 
     57output_eq( $path_to_parrot, File::Spec->catfile( $builddir, "parrot_config.pbc") . " prefix", 
     58           $builddir, "./parrot parrot_config.pbc prefix => build_dir"); 
     59output_eq( $path_to_cfg, "prefix", 
     60           $builddir, "./parrot_config prefix => build_dir"); 
     61output_eq( $path_to_cfg, "installed", 
     62           "0", "./parrot_config installed => 0"); 
     63 
     64my $path_to_inst = File::Spec->catfile( $builddir, "installable_parrot_config" ); 
     65my $exefile = $path_to_inst . $PConfig{exe}; 
     66SKIP: { 
     67    skip "installable_parrot_config hasn't been built. Run make installable", 2 unless -f $exefile; 
     68    output_eq( $exefile, "prefix", 
     69               $prefix, "./installable_parrot_config prefix => prefix"); 
     70    output_eq( $exefile, "installed", 
     71               "1", "./installable_parrot_config installed => 1"); 
     72} 
     73 
     74=head1 HELPER SUBROUTINES 
     75 
     76=head2 output_like 
     77 
     78    output_eq($path_to_cfg, "prefix", 
     79              "/usr/local", "$path_to_cfg prefix => /usr/local"); 
     80 
     81Takes 3-4 arguments: a program to run, the arguments, 
     82a regex string to match the the output, 
     83and the optional test diagnostic. 
     84 
     85=cut 
     86 
     87my $testno = 0; 
     88 
     89sub output_eq { 
     90    my ( $prog, $args, $check, $diag ) = @_; 
     91    $testno++; 
     92    my $stdoutfn = "$0.$testno.stdout"; 
     93    system("$prog $args >$stdoutfn 2>&1"); 
     94    my $f = IO::File->new($stdoutfn); 
     95 
     96    my $output = join( '', <$f> ); 
     97    $output =~ s/^\s+//g; 
     98    $output =~ s/\s+$//g; 
     99 
     100    local $Test::Builder::Level = $Test::Builder::Level + 1; 
     101    $f->close; 
     102    unlink ($stdoutfn); 
     103    is( $output, $check, $diag ); 
     104} 
     105 
     106=head1 TODO 
     107 
     108=over 4 
     109 
     110=item 
     111 
     112Flesh it out. 
     113This is a bare bones proof of concept just to check the --install logic. 
     114Add tests for all of the commands. 
     115 
     116=back 
     117 
     118=cut 
     119 
     120# Local Variables: 
     121#   mode: cperl 
     122#   cperl-indent-level: 4 
     123#   fill-column: 100 
     124# End: 
     125# vim: expandtab shiftwidth=4: