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