configpm

   1 #!./miniperl -w
   2
   3 # commonly used names to put first (and hence lookup fastest)
   4 my %Common = map {($_,$_)}
   5              qw(archname osname osvers prefix libs libpth
   6                 dynamic_ext static_ext dlsrc so
   7                 cc ccflags cppflags
   8                 privlibexp archlibexp installprivlib installarchlib
   9                 sharpbang startsh shsharp
  10                );
  11
  12 # names of things which may need to have slashes changed to double-colons
  13 my %Extensions = map {($_,$_)}
  14                  qw(dynamic_ext static_ext extensions known_extensions);
  15
  16 # allowed opts as well as specifies default and initial values
  17 my %Allowed_Opts = (
  18     'cross'    => '', # --cross=PALTFORM - crosscompiling for PLATFORM
  19     'glossary' => 1,  # --no-glossary  - no glossary file inclusion,
  20                       #                  for compactness
  21 );
  22
  23 sub opts {
  24     # user specified options
  25     my %given_opts = (
  26         # --opt=smth
  27         (map {/^--([\-_\w]+)=(.*)$/} @ARGV),
  28         # --opt --no-opt --noopt
  29         (map {/^no-?(.*)$/i?($1=>0):($_=>1)} map {/^--([\-_\w]+)$/} @ARGV),
  30     );
  31
  32     my %opts = (%Allowed_Opts, %given_opts);
  33
  34     for my $opt (grep {!exists $Allowed_Opts{$_}} keys %given_opts) {
  35         die "option '$opt' is not recognized";
  36     }
  37     @ARGV = grep {!/^--/} @ARGV;
  38
  39     return %opts;
  40 }
  41
  42
  43 my %Opts = opts();
  44
  45 my $Config_PM;
  46 my $Glossary = $ARGV[1] || 'Porting/Glossary';
  47
  48 if ($Opts{cross}) {
  49   # creating cross-platform config file
  50   mkdir "xlib";
  51   mkdir "xlib/$Opts{cross}";
  52   $Config_PM = $ARGV[0] || "xlib/$Opts{cross}/Config.pm";
  53 }
  54 else {
  55   $Config_PM = $ARGV[0] || 'lib/Config.pm';
  56 }
  57
  58
  59 open CONFIG, ">$Config_PM" or die "Can't open $Config_PM: $!\n";
  60
  61 my $myver = sprintf "v%vd", $^V;
  62
  63 printf CONFIG <<'ENDOFBEG', ($myver) x 3;
  64 # This file was created by configpm when Perl was built. Any changes
  65 # made to this file will be lost the next time perl is built.
  66
  67 package Config;
  68 @EXPORT = qw(%%Config);
  69 @EXPORT_OK = qw(myconfig config_sh config_vars config_re);
  70
  71 my %%Export_Cache = map {($_ => 1)} (@EXPORT, @EXPORT_OK);
  72
  73 # Define our own import method to avoid pulling in the full Exporter:
  74 sub import {
  75     my $pkg = shift;
  76     @_ = @EXPORT unless @_;
  77
  78     my @funcs = grep $_ ne '%%Config', @_;
  79     my $export_Config = @funcs < @_ ? 1 : 0;
  80
  81     my $callpkg = caller(0);
  82     foreach my $func (@funcs) {
  83         die sprintf qq{"%%s" is not exported by the %%s module\n},
  84             $func, __PACKAGE__ unless $Export_Cache{$func};
  85         *{$callpkg.'::'.$func} = \&{$func};
  86     }
  87
  88     *{"$callpkg\::Config"} = \%%Config if $export_Config;
  89     return;
  90 }
  91
  92 die "Perl lib version (%s) doesn't match executable version ($])"
  93     unless $^V;
  94
  95 $^V eq %s
  96     or die "Perl lib version (%s) doesn't match executable version (" .
  97         sprintf("v%%vd",$^V) . ")";
  98
  99 ENDOFBEG
 100
 101
 102 my @non_v    = ();
 103 my @v_fast   = ();
 104 my %v_fast   = ();
 105 my @v_others = ();
 106 my $in_v     = 0;
 107 my %Data     = ();
 108
 109 # This is somewhat grim, but I want the code for parsing config.sh here and
 110 # now so that I can expand $Config{ivsize} and $Config{ivtype}
 111
 112 my $fetch_string = <<'EOT';
 113
 114 # Search for it in the big string
 115 sub fetch_string {
 116     my($self, $key) = @_;
 117
 118     my $quote_type = "'";
 119     my $marker = "$key=";
 120
 121     # Check for the common case, ' delimited
 122     my $start = index($Config_SH, "\n$marker$quote_type");
 123     # If that failed, check for " delimited
 124     if ($start == -1) {
 125         $quote_type = '"';
 126         $start = index($Config_SH, "\n$marker$quote_type");
 127     }
 128     return undef if ( ($start == -1) &&  # in case it's first
 129                       (substr($Config_SH, 0, length($marker)) ne $marker) );
 130     if ($start == -1) {
 131         # It's the very first thing we found. Skip $start forward
 132         # and figure out the quote mark after the =.
 133         $start = length($marker) + 1;
 134         $quote_type = substr($Config_SH, $start - 1, 1);
 135     }
 136     else {
 137         $start += length($marker) + 2;
 138     }
 139
 140     my $value = substr($Config_SH, $start,
 141                        index($Config_SH, "$quote_type\n", $start) - $start);
 142
 143     # If we had a double-quote, we'd better eval it so escape
 144     # sequences and such can be interpolated. Since the incoming
 145     # value is supposed to follow shell rules and not perl rules,
 146     # we escape any perl variable markers
 147     if ($quote_type eq '"') {
 148         $value =~ s/\$/\\\$/g;
 149         $value =~ s/\@/\\\@/g;
 150         eval "\$value = \"$value\"";
 151     }
 152
 153     # So we can say "if $Config{'foo'}".
 154     $value = undef if $value eq 'undef';
 155     $self->{$key} = $value; # cache it
 156 }
 157 EOT
 158
 159 eval $fetch_string;
 160 die if $@;
 161
 162 open(CONFIG_SH, 'config.sh') || die "Can't open config.sh: $!";
 163 while (<CONFIG_SH>) {
 164     next if m:^#!/bin/sh:;
 165
 166     # Catch PERL_CONFIG_SH=true and PERL_VERSION=n line from Configure.
 167     s/^(\w+)=(true|\d+)\s*$/$1='$2'\n/ or m/^(\w+)='(.*)'$/;
 168     my($k, $v) = ($1, $2);
 169
 170     # grandfather PATCHLEVEL and SUBVERSION and CONFIG
 171     if ($k) {
 172         if ($k eq 'PERL_VERSION') {
 173             push @v_others, "PATCHLEVEL='$v'\n";
 174         }
 175         elsif ($k eq 'PERL_SUBVERSION') {
 176             push @v_others, "SUBVERSION='$v'\n";
 177         }
 178         elsif ($k eq 'PERL_CONFIG_SH') {
 179             push @v_others, "CONFIG='$v'\n";
 180         }
 181     }
 182
 183     # We can delimit things in config.sh with either ' or ".
 184     unless ($in_v or m/^(\w+)=(['"])(.*\n)/){
 185         push(@non_v, "#$_"); # not a name='value' line
 186         next;
 187     }
 188     $quote = $2;
 189     if ($in_v) {
 190         $val .= $_;
 191     }
 192     else {
 193         ($name,$val) = ($1,$3);
 194     }
 195     $in_v = $val !~ /$quote\n/;
 196     next if $in_v;
 197
 198     s,/,::,g if $Extensions{$name};
 199
 200     $val =~ s/$quote\n?\z//;
 201
 202     my $line = "$name=$quote$val$quote\n";
 203     if (!$Common{$name}){
 204         push(@v_others, $line);
 205     }
 206     else {
 207         push(@v_fast, $line);
 208         $v_fast{$name} = "'$name' => $quote$val$quote";
 209     }
 210 }
 211 close CONFIG_SH;
 212
 213 # Calculation for the keys for byteorder
 214 # This is somewhat grim, but I need to run fetch_string here.
 215 our $Config_SH = join "\n", @v_fast, @v_others;
 216
 217 my $t = fetch_string ({}, 'ivtype');
 218 my $s = fetch_string ({}, 'ivsize');
 219
 220 # byteorder does exist on its own but we overlay a virtual
 221 # dynamically recomputed value.
 222
 223 # However, ivtype and ivsize will not vary for sane fat binaries
 224
 225 my $f = $t eq 'long' ? 'L!' : $s == 8 ? 'Q': 'I';
 226
 227 my $byteorder_code;
 228 if ($s == 4 || $s == 8) {
 229     my $list = join ',', reverse(2..$s);
 230     my $format = 'a'x$s;
 231     $byteorder_code = <<"EOT";
 232 my \$i = 0;
 233 foreach my \$c ($list) { \$i |= ord(\$c); \$i <<= 8 }
 234 \$i |= ord(1);
 235 my \$byteorder = join('', unpack('$format', pack('$f', \$i)));
 236 EOT
 237 } else {
 238     $byteorder_code = "my \$byteorder = '?'x$s;\n";
 239 }
 240
 241 print CONFIG @non_v, "\n";
 242
 243 # copy config summary format from the myconfig.SH script
 244 print CONFIG "our \$summary : unique = <<'!END!';\n";
 245 open(MYCONFIG,"<myconfig.SH") || die "open myconfig.SH failed: $!";
 246 1 while defined($_ = <MYCONFIG>) && !/^Summary of/;
 247 do { print CONFIG $_ } until !defined($_ = <MYCONFIG>) || /^\s*$/;
 248 close(MYCONFIG);
 249
 250 # NB. as $summary is unique, we need to copy it in a lexical variable
 251 # before expanding it, because may have been made readonly if a perl
 252 # interpreter has been cloned.
 253
 254 print CONFIG "\n!END!\n", $byteorder_code, <<'EOT';
 255 my $summary_expanded;
 256
 257 sub myconfig {
 258     return $summary_expanded if $summary_expanded;
 259     ($summary_expanded = $summary) =~ s{\$(\w+)}
 260                  { my $c = $Config{$1}; defined($c) ? $c : 'undef' }ge;
 261     $summary_expanded;
 262 }
 263
 264 local *_ = \my $a;
 265 $_ = <<'!END!';
 266 EOT
 267
 268 print CONFIG join("", @v_fast, sort @v_others);
 269
 270 print CONFIG <<'EOT';
 271 !END!
 272 s/(byteorder=)(['"]).*?\2/$1$2$byteorder$2/m;
 273 our $Config_SH : unique = $_;
 274 EOT
 275
 276 print CONFIG $fetch_string;
 277
 278 print CONFIG <<'ENDOFEND';
 279
 280 sub fetch_virtual {
 281     my($self, $key) = @_;
 282
 283     my $value;
 284
 285     if ($key =~ /^((?:cc|ld)flags|libs(?:wanted)?)_nolargefiles/) {
 286         # These are purely virtual, they do not exist, but need to
 287         # be computed on demand for largefile-incapable extensions.
 288         my $new_key = "${1}_uselargefiles";
 289         $value = $Config{$1};
 290         my $withlargefiles = $Config{$new_key};
 291         if ($new_key =~ /^(?:cc|ld)flags_/) {
 292             $value =~ s/\Q$withlargefiles\E\b//;
 293         } elsif ($new_key =~ /^libs/) {
 294             my @lflibswanted = split(' ', $Config{libswanted_uselargefiles});
 295             if (@lflibswanted) {
 296                 my %lflibswanted;
 297                 @lflibswanted{@lflibswanted} = ();
 298                 if ($new_key =~ /^libs_/) {
 299                     my @libs = grep { /^-l(.+)/ &&
 300                                       not exists $lflibswanted{$1} }
 301                                     split(' ', $Config{libs});
 302                     $Config{libs} = join(' ', @libs);
 303                 } elsif ($new_key =~ /^libswanted_/) {
 304                     my @libswanted = grep { not exists $lflibswanted{$_} }
 305                                           split(' ', $Config{libswanted});
 306                     $Config{libswanted} = join(' ', @libswanted);
 307                 }
 308             }
 309         }
 310     }
 311
 312     $self->{$key} = $value;
 313 }
 314
 315 sub FETCH {
 316     my($self, $key) = @_;
 317
 318     # check for cached value (which may be undef so we use exists not defined)
 319     return $self->{$key} if exists $self->{$key};
 320
 321     $self->fetch_string($key);
 322     return $self->{$key} if exists $self->{$key};
 323     $self->fetch_virtual($key);
 324
 325     # Might not exist, in which undef is correct.
 326     return $self->{$key};
 327 }
 328
 329 my $prevpos = 0;
 330
 331 sub FIRSTKEY {
 332     $prevpos = 0;
 333     substr($Config_SH, 0, index($Config_SH, '=') );
 334 }
 335
 336 sub NEXTKEY {
 337     # Find out how the current key's quoted so we can skip to its end.
 338     my $quote = substr($Config_SH, index($Config_SH, "=", $prevpos)+1, 1);
 339     my $pos = index($Config_SH, qq($quote\n), $prevpos) + 2;
 340     my $len = index($Config_SH, "=", $pos) - $pos;
 341     $prevpos = $pos;
 342     $len > 0 ? substr($Config_SH, $pos, $len) : undef;
 343 }
 344
 345 sub EXISTS {
 346     return 1 if exists($_[0]->{$_[1]});
 347
 348     return(index($Config_SH, "\n$_[1]='") != -1 or
 349            substr($Config_SH, 0, length($_[1])+2) eq "$_[1]='" or
 350            index($Config_SH, "\n$_[1]=\"") != -1 or
 351            substr($Config_SH, 0, length($_[1])+2) eq "$_[1]=\"" or
 352            $_[1] =~ /^(?:(?:cc|ld)flags|libs(?:wanted)?)_nolargefiles$/
 353           );
 354 }
 355
 356 sub STORE  { die "\%Config::Config is read-only\n" }
 357 *DELETE = \&STORE;
 358 *CLEAR  = \&STORE;
 359
 360
 361 sub config_sh {
 362     $Config_SH
 363 }
 364
 365 sub config_re {
 366     my $re = shift;
 367     return map { chomp; $_ } grep eval{ /^(?:$re)=/ }, split /^/, $Config_SH;
 368 }
 369
 370 sub config_vars {
 371     foreach (@_) {
 372         my ($notag,$qry,$lncont) = m/^(:)?(.*?)(:)?$/;  # flags fore and aft,
 373         my $prfx = $notag ? '': "$qry=";                # prefix for print
 374         my $lnend = $lncont ? ' ' : ";\n";              # ending for print
 375
 376         if ($qry =~ /\W/) {
 377             my @matches = config_re($qry);
 378             print map "$_$lnend", @matches ? @matches : "$qry: not found"               if !$notag;
 379             print map { s/\w+=//; "$_$lnend" } @matches ? @matches : "$qry: not found"  if  $notag;
 380         } else {
 381             my $v = (exists $Config{$qry}) ? $Config{$qry} : 'UNKNOWN';
 382             $v = 'undef' unless defined $v;
 383             print "${prfx}'${v}'$lnend";
 384         }
 385     }
 386 }
 387
 388 ENDOFEND
 389
 390 if ($^O eq 'os2') {
 391     print CONFIG <<'ENDOFSET';
 392 my %preconfig;
 393 if ($OS2::is_aout) {
 394     my ($value, $v) = $Config_SH =~ m/^used_aout='(.*)'\s*$/m;
 395     for (split ' ', $value) {
 396         ($v) = $Config_SH =~ m/^aout_$_='(.*)'\s*$/m;
 397         $preconfig{$_} = $v eq 'undef' ? undef : $v;
 398     }
 399 }
 400 $preconfig{d_fork} = undef unless $OS2::can_fork; # Some funny cases can't
 401 sub TIEHASH { bless {%preconfig} }
 402 ENDOFSET
 403     # Extract the name of the DLL from the makefile to avoid duplication
 404     my ($f) = grep -r, qw(GNUMakefile Makefile);
 405     my $dll;
 406     if (open my $fh, '<', $f) {
 407         while (<$fh>) {
 408             $dll = $1, last if /^PERL_DLL_BASE\s*=\s*(\S*)\s*$/;
 409         }
 410     }
 411     print CONFIG <<ENDOFSET if $dll;
 412 \$preconfig{dll_name} = '$dll';
 413 ENDOFSET
 414 } else {
 415     print CONFIG <<'ENDOFSET';
 416 sub TIEHASH {
 417     bless $_[1], $_[0];
 418 }
 419 ENDOFSET
 420 }
 421
 422 my $fast_config = join '', map { "    $_,\n" }
 423     sort values (%v_fast), 'byteorder => $byteorder' ;
 424
 425 print CONFIG sprintf <<'ENDOFTIE', $fast_config;
 426
 427 # avoid Config..Exporter..UNIVERSAL search for DESTROY then AUTOLOAD
 428 sub DESTROY { }
 429
 430 tie %%Config, 'Config', {
 431 %s
 432 };
 433
 434 1;
 435 ENDOFTIE
 436
 437
 438 open(CONFIG_POD, ">lib/Config.pod") or die "Can't open lib/Config.pod: $!";
 439 print CONFIG_POD <<'ENDOFTAIL';
 440 =head1 NAME
 441
 442 Config - access Perl configuration information
 443
 444 =head1 SYNOPSIS
 445
 446     use Config;
 447     if ($Config{usethreads}) {
 448         print "has thread support\n"
 449     }
 450
 451     use Config qw(myconfig config_sh config_vars config_re);
 452
 453     print myconfig();
 454
 455     print config_sh();
 456
 457     print config_re();
 458
 459     config_vars(qw(osname archname));
 460
 461
 462 =head1 DESCRIPTION
 463
 464 The Config module contains all the information that was available to
 465 the C<Configure> program at Perl build time (over 900 values).
 466
 467 Shell variables from the F<config.sh> file (written by Configure) are
 468 stored in the readonly-variable C<%Config>, indexed by their names.
 469
 470 Values stored in config.sh as 'undef' are returned as undefined
 471 values.  The perl C<exists> function can be used to check if a
 472 named variable exists.
 473
 474 =over 4
 475
 476 =item myconfig()
 477
 478 Returns a textual summary of the major perl configuration values.
 479 See also C<-V> in L<perlrun/Switches>.
 480
 481 =item config_sh()
 482
 483 Returns the entire perl configuration information in the form of the
 484 original config.sh shell variable assignment script.
 485
 486 =item config_re($regex)
 487
 488 Like config_sh() but returns, as a list, only the config entries who's
 489 names match the $regex.
 490
 491 =item config_vars(@names)
 492
 493 Prints to STDOUT the values of the named configuration variable. Each is
 494 printed on a separate line in the form:
 495
 496   name='value';
 497
 498 Names which are unknown are output as C<name='UNKNOWN';>.
 499 See also C<-V:name> in L<perlrun/Switches>.
 500
 501 =back
 502
 503 =head1 EXAMPLE
 504
 505 Here's a more sophisticated example of using %Config:
 506
 507     use Config;
 508     use strict;
 509
 510     my %sig_num;
 511     my @sig_name;
 512     unless($Config{sig_name} && $Config{sig_num}) {
 513         die "No sigs?";
 514     } else {
 515         my @names = split ' ', $Config{sig_name};
 516         @sig_num{@names} = split ' ', $Config{sig_num};
 517         foreach (@names) {
 518             $sig_name[$sig_num{$_}] ||= $_;
 519         }
 520     }
 521
 522     print "signal #17 = $sig_name[17]\n";
 523     if ($sig_num{ALRM}) {
 524         print "SIGALRM is $sig_num{ALRM}\n";
 525     }
 526
 527 =head1 WARNING
 528
 529 Because this information is not stored within the perl executable
 530 itself it is possible (but unlikely) that the information does not
 531 relate to the actual perl binary which is being used to access it.
 532
 533 The Config module is installed into the architecture and version
 534 specific library directory ($Config{installarchlib}) and it checks the
 535 perl version number when loaded.
 536
 537 The values stored in config.sh may be either single-quoted or
 538 double-quoted. Double-quoted strings are handy for those cases where you
 539 need to include escape sequences in the strings. To avoid runtime variable
 540 interpolation, any C<$> and C<@> characters are replaced by C<\$> and
 541 C<\@>, respectively. This isn't foolproof, of course, so don't embed C<\$>
 542 or C<\@> in double-quoted strings unless you're willing to deal with the
 543 consequences. (The slashes will end up escaped and the C<$> or C<@> will
 544 trigger variable interpolation)
 545
 546 =head1 GLOSSARY
 547
 548 Most C<Config> variables are determined by the C<Configure> script
 549 on platforms supported by it (which is most UNIX platforms).  Some
 550 platforms have custom-made C<Config> variables, and may thus not have
 551 some of the variables described below, or may have extraneous variables
 552 specific to that particular port.  See the port specific documentation
 553 in such cases.
 554
 555 ENDOFTAIL
 556
 557 if ($Opts{glossary}) {
 558   open(GLOS, "<$Glossary") or die "Can't open $Glossary: $!";
 559 }
 560 %seen = ();
 561 $text = 0;
 562 $/ = '';
 563
 564 sub process {
 565   if (s/\A(\w*)\s+\(([\w.]+)\):\s*\n(\t?)/=item C<$1>\n\nFrom F<$2>:\n\n/m) {
 566     my $c = substr $1, 0, 1;
 567     unless ($seen{$c}++) {
 568       print CONFIG_POD <<EOF if $text;
 569 =back
 570
 571 EOF
 572       print CONFIG_POD <<EOF;
 573 =head2 $c
 574
 575 =over 4
 576
 577 EOF
 578      $text = 1;
 579     }
 580   }
 581   elsif (!$text || !/\A\t/) {
 582     warn "Expected a Configure variable header",
 583       ($text ? " or another paragraph of description" : () );
 584   }
 585   s/n't/n\00t/g;                # leave can't, won't etc untouched
 586   s/^\t\s+(.*)/\n$1/gm;         # Indented lines ===> new paragraph
 587   s/^(?<!\n\n)\t(.*)/$1/gm;     # Not indented lines ===> text
 588   s{([\'\"])(?=[^\'\"\s]*[./][^\'\"\s]*\1)([^\'\"\s]+)\1}(F<$2>)g; # '.o'
 589   s{([\'\"])([^\'\"\s]+)\1}(C<$2>)g; # "date" command
 590   s{\'([A-Za-z_\- *=/]+)\'}(C<$1>)g; # 'ln -s'
 591   s{
 592      (?<! [\w./<\'\"] )         # Only standalone file names
 593      (?! e \. g \. )            # Not e.g.
 594      (?! \. \. \. )             # Not ...
 595      (?! \d )                   # Not 5.004
 596      (?! read/ )                # Not read/write
 597      (?! etc\. )                # Not etc.
 598      (?! I/O )                  # Not I/O
 599      (
 600         \$ ?                    # Allow leading $
 601         [\w./]* [./] [\w./]*    # Require . or / inside
 602      )
 603      (?<! \. (?= [\s)] ) )      # Do not include trailing dot
 604      (?! [\w/] )                # Include all of it
 605    }
 606    (F<$1>)xg;                   # /usr/local
 607   s/((?<=\s)~\w*)/F<$1>/g;      # ~name
 608   s/(?<![.<\'\"])\b([A-Z_]{2,})\b(?![\'\"])/C<$1>/g;    # UNISTD
 609   s/(?<![.<\'\"])\b(?!the\b)(\w+)\s+macro\b/C<$1> macro/g; # FILE_cnt macro
 610   s/n[\0]t/n't/g;               # undo can't, won't damage
 611 }
 612
 613 if ($Opts{glossary}) {
 614     <GLOS>;                             # Skip the "DO NOT EDIT"
 615     <GLOS>;                             # Skip the preamble
 616   while (<GLOS>) {
 617     process;
 618     print CONFIG_POD;
 619   }
 620 }
 621
 622 print CONFIG_POD <<'ENDOFTAIL';
 623
 624 =back
 625
 626 =head1 NOTE
 627
 628 This module contains a good example of how to use tie to implement a
 629 cache and an example of how to make a tied variable readonly to those
 630 outside of it.
 631
 632 =cut
 633
 634 ENDOFTAIL
 635
 636 close(CONFIG);
 637 close(GLOS);
 638 close(CONFIG_POD);
 639
 640 # Now create Cross.pm if needed
 641 if ($Opts{cross}) {
 642   open CROSS, ">lib/Cross.pm" or die "Can not open >lib/Cross.pm: $!";
 643   my $cross = <<'EOS';
 644 # typical invocation:
 645 #   perl -MCross Makefile.PL
 646 #   perl -MCross=wince -V:cc
 647 package Cross;
 648
 649 sub import {
 650   my ($package,$platform) = @_;
 651   unless (defined $platform) {
 652     # if $platform is not specified, then use last one when
 653     # 'configpm; was invoked with --cross option
 654     $platform = '***replace-marker***';
 655   }
 656   @INC = map {/\blib\b/?(do{local $_=$_;s/\blib\b/xlib\/$platform/;$_},$_):($_)} @INC;
 657   $::Cross::platform = $platform;
 658 }
 659
 660 1;
 661 EOS
 662   $cross =~ s/\*\*\*replace-marker\*\*\*/$Opts{cross}/g;
 663   print CROSS $cross;
 664   close CROSS;
 665 }
 666
 667 # Now do some simple tests on the Config.pm file we have created
 668 unshift(@INC,'lib');
 669 require $Config_PM;
 670 import Config;
 671
 672 die "$0: $Config_PM not valid"
 673         unless $Config{'PERL_CONFIG_SH'} eq 'true';
 674
 675 die "$0: error processing $Config_PM"
 676         if defined($Config{'an impossible name'})
 677         or $Config{'PERL_CONFIG_SH'} ne 'true' # test cache
 678         ;
 679
 680 die "$0: error processing $Config_PM"
 681         if eval '$Config{"cc"} = 1'
 682         or eval 'delete $Config{"cc"}'
 683         ;
 684
 685
 686 exit 0;