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