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