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