lib/ExtUtils/t/Mkbootstrap.t

   1 #!/usr/bin/perl -w
   2
   3 BEGIN {
   4     if( $ENV{PERL_CORE} ) {
   5         chdir 't';
   6         @INC = ('../lib', 'lib/');
   7     }
   8     else {
   9         unshift @INC, 't/lib/';
  10     }
  11 }
  12 chdir 't';
  13
  14 use vars qw( $required );
  15 use Test::More tests => 18;
  16
  17 BEGIN { use_ok( 'ExtUtils::Mkbootstrap' ) }
  18
  19 # Mkbootstrap makes a backup copy of "$_[0].bs" if it exists and is non-zero
  20 my $file_is_ready;
  21 local *OUT;
  22 if (open(OUT, '>mkboot.bs')) {
  23         $file_is_ready = 1;
  24         print OUT 'meaningless text';
  25         close OUT;
  26 }
  27
  28 SKIP: {
  29         skip("could not make dummy .bs file: $!", 2) unless $file_is_ready;
  30
  31         Mkbootstrap('mkboot');
  32         ok( -s 'mkboot.bso', 'Mkbootstrap should backup the .bs file' );
  33         local *IN;
  34         if (open(IN, 'mkboot.bso')) {
  35                 chomp ($file_is_ready = <IN>);
  36                 close IN;
  37         }
  38
  39         is( $file_is_ready, 'meaningless text', 'backup should be a perfect copy' );
  40 }
  41
  42
  43 # if it doesn't exist or is zero bytes in size, it won't be backed up
  44 Mkbootstrap('fakeboot');
  45 ok( !( -f 'fakeboot.bso' ), 'Mkbootstrap should not backup an empty file' );
  46
  47 use TieOut;
  48 my $out = tie *STDOUT, 'TieOut';
  49
  50 # with $Verbose set, it should print status messages about libraries
  51 $ExtUtils::Mkbootstrap::Verbose = 1;
  52 Mkbootstrap('');
  53 is( $out->read, "\tbsloadlibs=\n", 'should report libraries in Verbose mode' );
  54
  55 Mkbootstrap('', 'foo');
  56 like( $out->read, qr/bsloadlibs=foo/, 'should still report libraries' );
  57
  58
  59 # if ${_[0]}_BS exists, require it
  60 $file_is_ready = open(OUT, '>boot_BS');
  61
  62 SKIP: {
  63         skip("cannot open boot_BS for writing: $!", 1) unless $file_is_ready;
  64
  65         print OUT '$main::required = 1';
  66         close OUT;
  67         Mkbootstrap('boot');
  68
  69         ok( $required, 'baseext_BS file should be require()d' );
  70 }
  71
  72
  73 # if there are any arguments, open a file named baseext.bs
  74 $file_is_ready = open(OUT, '>dasboot.bs');
  75
  76 SKIP: {
  77         skip("cannot make dasboot.bs: $!", 5) unless $file_is_ready;
  78
  79         # if it can't be opened for writing, we want to prove that it'll die
  80         close OUT;
  81         chmod 0444, 'dasboot.bs';
  82
  83         SKIP: {
  84             skip("cannot write readonly files", 1) if -w 'dasboot.bs';
  85
  86             eval{ Mkbootstrap('dasboot', 1) };
  87             like( $@, qr/Unable to open dasboot\.bs/, 'should die given bad filename' );
  88         }
  89
  90         # now put it back like it was
  91         chmod 0777, 'dasboot.bs';
  92         eval{ Mkbootstrap('dasboot', 'myarg') };
  93         is( $@, '', 'should not die, given good filename' );
  94
  95         # red and reed (a visual pun makes tests worth reading)
  96         my $read = $out->read();
  97         like( $read, qr/Writing dasboot.bs/, 'should print status' );
  98         like( $read, qr/containing: my/, 'should print verbose status on request' );
  99
 100         # now be tricky, and set the status for the next skip block
 101         $file_is_ready = open(IN, 'dasboot.bs');
 102         ok( $file_is_ready, 'should have written a new .bs file' );
 103 }
 104
 105
 106 SKIP: {
 107         skip("cannot read .bs file: $!", 2) unless $file_is_ready;
 108
 109         my $file = do { local $/ = <IN> };
 110
 111         # filename should be in header
 112         like( $file, qr/# dasboot DynaLoader/, 'file should have boilerplate' );
 113
 114         # should print arguments within this array
 115         like( $file, qr/qw\(myarg\);/, 'should have written array to file' );
 116 }
 117
 118
 119 # overwrite this file (may whack portability, but the name's too good to waste)
 120 $file_is_ready = open(OUT, '>dasboot.bs');
 121
 122 SKIP: {
 123         skip("cannot make dasboot.bs again: $!", 1) unless $file_is_ready;
 124         close OUT;
 125
 126         # if $DynaLoader::bscode is set, write its contents to the file
 127     local $DynaLoader::bscode;
 128         $DynaLoader::bscode = 'Wall';
 129         $ExtUtils::Mkbootstrap::Verbose = 0;
 130
 131         # if arguments contain '-l' or '-L' or '-R' print dl_findfile message
 132         eval{ Mkbootstrap('dasboot', '-Larry') };
 133         is( $@, '', 'should be able to open a file again');
 134
 135         $file_is_ready = open(IN, 'dasboot.bs');
 136 }
 137
 138 SKIP: {
 139         skip("cannot open dasboot.bs for reading: $!", 3) unless $file_is_ready;
 140
 141         my $file = do { local $/ = <IN> };
 142         is( $out->read, "Writing dasboot.bs\n", 'should hush without Verbose set' );
 143
 144         # and find our hidden tribute to a fine example
 145         like( $file, qr/dl_findfile.+Larry/s, 'should load libraries if needed' );
 146         like( $file, qr/Wall\n1;\n/ms, 'should write $DynaLoader::bscode if set' );
 147 }
 148
 149 close IN;
 150 close OUT;
 151
 152 END {
 153         # clean things up, even on VMS
 154         1 while unlink(qw( mkboot.bso boot_BS dasboot.bs .bs ));
 155 }