4 if( $ENV{PERL_CORE} ) {
6 @INC = ('../lib', 'lib/');
9 unshift @INC, 't/lib/';
14 use vars qw( $required );
15 use Test::More tests => 18;
17 BEGIN { use_ok( 'ExtUtils::Mkbootstrap' ) }
19 # Mkbootstrap makes a backup copy of "$_[0].bs" if it exists and is non-zero
22 if (open(OUT, '>mkboot.bs')) {
24 print OUT 'meaningless text';
29 skip("could not make dummy .bs file: $!", 2) unless $file_is_ready;
31 Mkbootstrap('mkboot');
32 ok( -s 'mkboot.bso', 'Mkbootstrap should backup the .bs file' );
34 if (open(IN, 'mkboot.bso')) {
35 chomp ($file_is_ready = <IN>);
39 is( $file_is_ready, 'meaningless text', 'backup should be a perfect copy' );
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' );
48 my $out = tie *STDOUT, 'TieOut';
50 # with $Verbose set, it should print status messages about libraries
51 $ExtUtils::Mkbootstrap::Verbose = 1;
53 is( $out->read, "\tbsloadlibs=\n", 'should report libraries in Verbose mode' );
55 Mkbootstrap('', 'foo');
56 like( $out->read, qr/bsloadlibs=foo/, 'should still report libraries' );
59 # if ${_[0]}_BS exists, require it
60 $file_is_ready = open(OUT, '>boot_BS');
63 skip("cannot open boot_BS for writing: $!", 1) unless $file_is_ready;
65 print OUT '$main::required = 1';
69 ok( $required, 'baseext_BS file should be require()d' );
73 # if there are any arguments, open a file named baseext.bs
74 $file_is_ready = open(OUT, '>dasboot.bs');
77 skip("cannot make dasboot.bs: $!", 5) unless $file_is_ready;
79 # if it can't be opened for writing, we want to prove that it'll die
81 chmod 0444, 'dasboot.bs';
84 skip("cannot write readonly files", 1) if -w 'dasboot.bs';
86 eval{ Mkbootstrap('dasboot', 1) };
87 like( $@, qr/Unable to open dasboot\.bs/, 'should die given bad filename' );
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' );
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' );
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' );
107 skip("cannot read .bs file: $!", 2) unless $file_is_ready;
109 my $file = do { local $/ = <IN> };
111 # filename should be in header
112 like( $file, qr/# dasboot DynaLoader/, 'file should have boilerplate' );
114 # should print arguments within this array
115 like( $file, qr/qw\(myarg\);/, 'should have written array to file' );
119 # overwrite this file (may whack portability, but the name's too good to waste)
120 $file_is_ready = open(OUT, '>dasboot.bs');
123 skip("cannot make dasboot.bs again: $!", 1) unless $file_is_ready;
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;
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');
135 $file_is_ready = open(IN, 'dasboot.bs');
139 skip("cannot open dasboot.bs for reading: $!", 3) unless $file_is_ready;
141 my $file = do { local $/ = <IN> };
142 is( $out->read, "Writing dasboot.bs\n", 'should hush without Verbose set' );
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' );
153 # clean things up, even on VMS
154 1 while unlink(qw( mkboot.bso boot_BS dasboot.bs .bs ));