1#!/usr/bin/perl -w
2
3BEGIN {
4    if( $ENV{PERL_CORE} ) {
5        chdir 't';
6        @INC = ('../lib', 'lib/');
7    }
8    else {
9        unshift @INC, 't/lib/';
10    }
11}
12chdir 't';
13
14use vars qw( $required );
15use Test::More tests => 18;
16
17BEGIN { use_ok( 'ExtUtils::Mkbootstrap' ) }
18
19# Mkbootstrap makes a backup copy of "$_[0].bs" if it exists and is non-zero
20my $file_is_ready;
21local *OUT;
22if (open(OUT, '>mkboot.bs')) {
23	$file_is_ready = 1;
24	print OUT 'meaningless text';
25	close OUT;
26}
27
28SKIP: {
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
44Mkbootstrap('fakeboot');
45ok( !( -f 'fakeboot.bso' ), 'Mkbootstrap should not backup an empty file' );
46
47use TieOut;
48my $out = tie *STDOUT, 'TieOut';
49
50# with $Verbose set, it should print status messages about libraries
51$ExtUtils::Mkbootstrap::Verbose = 1;
52Mkbootstrap('');
53is( $out->read, "\tbsloadlibs=\n", 'should report libraries in Verbose mode' );
54
55Mkbootstrap('', 'foo');
56like( $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
62SKIP: {
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
76SKIP: {
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
106SKIP: {
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
122SKIP: {
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
138SKIP: {
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
149close IN;
150close OUT;
151
152END {
153	# clean things up, even on VMS
154	1 while unlink(qw( mkboot.bso boot_BS dasboot.bs .bs ));
155}
156