15 ok(keys %Config > 500, "Config has more than 500 entries");
17 my ($first) = Config::config_sh() =~ /^(\S+)=/m;
18 die "Can't find first entry in Config::config_sh()" unless defined $first;
19 print "# First entry is '$first'\n";
21 # It happens that the we know what the first key should be. This is somewhat
22 # cheating, but there was briefly a bug where the key got a bonus newline.
23 my ($first_each) = each %Config;
24 is($first_each, $first, "First key from each is correct");
25 ok(exists($Config{$first_each}), "First key exists");
26 ok(!exists($Config{"\n$first"}),
27 "Check that first key with prepended newline isn't falsely existing");
29 is($Config{PERL_REVISION}, 5, "PERL_REVISION is 5");
31 # Check that old config variable names are aliased to their new ones.
32 my %grandfathers = ( PERL_VERSION => 'PATCHLEVEL',
33 PERL_SUBVERSION => 'SUBVERSION',
34 PERL_CONFIG_SH => 'CONFIG'
36 while( my($new, $old) = each %grandfathers ) {
37 isnt($Config{$new}, undef, "$new is defined");
38 is($Config{$new}, $Config{$old}, "$new is aliased to $old");
41 ok( exists $Config{cc}, "has cc");
43 ok( exists $Config{ccflags}, "has ccflags");
45 ok(!exists $Config{python}, "has no python");
47 ok( exists $Config{d_fork}, "has d_fork");
49 ok(!exists $Config{d_bork}, "has no d_bork");
51 like($Config{ivsize}, qr/^(4|8)$/, "ivsize is 4 or 8 (it is $Config{ivsize})");
53 # byteorder is virtual, but it has rules.
55 like($Config{byteorder}, qr/^(1234|4321|12345678|87654321)$/,
56 "byteorder is 1234 or 4321 or 12345678 or 87654321 "
57 . "(it is $Config{byteorder})");
59 is(length $Config{byteorder}, $Config{ivsize},
60 "byteorder is as long as ivsize (which is $Config{ivsize})");
62 # ccflags_nolargefiles is virtual, too.
64 ok(exists $Config{ccflags_nolargefiles}, "has ccflags_nolargefiles");
69 # make sure we can export what we say we can export.
71 my @exports = qw(myconfig config_sh config_vars config_re);
72 Config->import(@exports);
73 foreach my $func (@exports) {
74 ::ok( __PACKAGE__->can($func), "$func exported" );
78 like(Config::myconfig(), qr/osname=\Q$Config{osname}\E/, "myconfig");
79 like(Config::config_sh(), qr/osname='\Q$Config{osname}\E'/, "config_sh");
80 like(Config::config_sh(), qr/byteorder='[1-8]+'/,
81 "config_sh has a valid byteorder");
82 foreach my $line (Config::config_re('c.*')) {
83 like($line, qr/^c.*?=.*$/, 'config_re' );
86 my $out = tie *STDOUT, 'FakeOut';
88 Config::config_vars('cc'); # non-regex test of essential cfg-var
92 Config::config_vars('d_bork'); # non-regex, non-existent cfg-var
96 Config::config_vars('PERL_API_.*'); # regex, tagged multi-line answer
100 Config::config_vars('PERL_API_.*:'); # regex, tagged single-line answer
104 Config::config_vars(':PERL_API_.*:'); # regex, non-tagged single-line answer
108 Config::config_vars(':PERL_API_.*'); # regex, non-tagged multi-line answer
112 Config::config_vars('PERL_API_REVISION.*:'); # regex, tagged
116 # regex, non-tagged multi-line answer
117 Config::config_vars(':PERL_API_REVISION.*');
121 Config::config_vars('PERL_EXPENSIVE_.*:'); # non-matching regex
125 Config::config_vars('?flags'); # bogus regex, no explicit warning !
131 like($out1, qr/^cc='\Q$Config{cc}\E';/, "found config_var cc");
132 like($out2, qr/^d_bork='UNKNOWN';/, "config_var d_bork is UNKNOWN");
134 # test for leading, trailing colon effects
135 is(scalar split(/;\n/, $out3), 3, "3 lines found");
136 is(scalar split(/;\n/, $out6), 3, "3 lines found");
138 is($out4 =~ /(;\n)/s, '', "trailing colon gives 1-line response: $out4");
139 is($out5 =~ /(;\n)/s, '', "trailing colon gives 1-line response: $out5");
141 is(scalar split(/=/, $out3), 4, "found 'tag='");
142 is(scalar split(/=/, $out4), 4, "found 'tag='");
146 my @rev = @Config{qw(PERL_API_REVISION PERL_API_VERSION PERL_API_SUBVERSION)};
148 print ("# test tagged responses, multi-line and single-line\n");
149 foreach $api ($out3, $out4) {
150 @api = $api =~ /PERL_API_(\w+)=(.*?)(?:;\n|\s)/mg;
151 is($api[0], "REVISION", "REVISION tag");
152 is($api[4], "VERSION", "VERSION tag");
153 is($api[2], "SUBVERSION", "SUBVERSION tag");
154 is($api[1], "'$rev[0]'", "REVISION is $rev[0]");
155 is($api[5], "'$rev[1]'", "VERSION is $rev[1]");
156 is($api[3], "'$rev[2]'", "SUBVERSION is $rev[2]");
159 print("# test non-tagged responses, multi-line and single-line\n");
160 foreach $api ($out5, $out6) {
161 @api = split /(?: |;\n)/, $api;
162 is($api[0], "'$rev[0]'", "revision is $rev[0]");
163 is($api[2], "'$rev[1]'", "version is $rev[1]");
164 is($api[1], "'$rev[2]'", "subversion is $rev[2]");
167 # compare to each other, the outputs for trailing, leading colon
169 is("$out7;\n", "PERL_API_REVISION=$out8", "got expected diffs");
171 like($out9, qr/\bnot\s+found\b/, "$out9 - perl is FREE !");
172 like($out10, qr/\bnot\s+found\b/, "config_vars with invalid regexp");
177 eval { $Config{d_bork} = 'borkbork' };
178 like($@, qr/Config is read-only/, "no STORE");
180 ok(!exists $Config{d_bork}, "still no d_bork");
183 eval { delete $Config{d_fork} };
184 like($@, qr/Config is read-only/, "no DELETE");
186 ok( exists $Config{d_fork}, "still d_fork");
189 eval { %Config = () };
190 like($@, qr/Config is read-only/, "no CLEAR");
192 ok( exists $Config{d_fork}, "still d_fork");
198 bless(\(my $text), $_[0]);
207 $$self .= join('', @_);
211 # Signal-related variables
212 # (this is actually a regression test for Configure.)
214 is($Config{sig_num_init} =~ tr/,/,/, $Config{sig_size}, "sig_num_init size");
215 is($Config{sig_name_init} =~ tr/,/,/, $Config{sig_size}, "sig_name_init size");
217 # Test the troublesome virtual stuff
218 my @virtual = qw(byteorder ccflags_nolargefiles ldflags_nolargefiles
219 libs_nolargefiles libswanted_nolargefiles);
221 # Also test that the first entry in config.sh is found correctly. There was
222 # special casing code for this
224 foreach my $pain ($first, @virtual) {
225 # No config var is named with anything that is a regexp metachar
226 ok(exists $Config{$pain}, "\$config('$pain') exists");
228 my @result = $Config{$pain};
229 is (scalar @result, 1, "single result for \$config('$pain')");
231 @result = Config::config_re($pain);
232 is (scalar @result, 1, "single result for config_re('$pain')");
233 like ($result[0], qr/^$pain=(['"])\Q$Config{$pain}\E\1$/, # grr '
234 "which is the expected result for $pain");
237 # Check that config entries appear correctly in @INC
238 # TestInit.pm has probably already messed with our @INC
239 # This little bit of evil is to avoid a @ in the program, in case it confuses
240 # shell 1 liners. Perl 1 rules.
241 my ($path, $ver, @orig_inc)
244 prog=>'print qq{$^X\n$]\n}; print qq{$_\n} while $_ = shift INC');
246 die "This perl is $] at $^X; other perl is $ver (at $path) "
247 . '- failed to find this perl' unless $] eq $ver;
250 @orig_inc{@orig_inc} = ();
253 # This is the order that directories are pushed onto @INC in perl.c:
254 foreach my $lib (qw(applibexp archlibexp privlibexp sitearchexp sitelibexp
255 vendorarchexp vendorlibexp vendorlib_stem)) {
256 my $dir = $Config{$lib};
258 skip "lib $lib not defined" unless defined $dir;
259 skip "lib $lib not set" unless length $dir;
260 # So we expect to find it in @INC
262 ok (exists $orig_inc{$dir}, "Expect $lib '$dir' to be in \@INC")
266 _diag ('@INC is:', @orig_inc) if $failed;