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