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