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     # implements -V:cfgvar option (see perlrun -V:)
 372     foreach (@_) {
 373         # find optional leading, trailing colons; and query-spec
 374         my ($notag,$qry,$lncont) = m/^(:)?(.*?)(:)?$/;  # flags fore and aft,
 375         # map colon-flags to print decorations
 376         my $prfx = $notag ? '': "$qry=";                # tag-prefix for print
 377         my $lnend = $lncont ? ' ' : ";\n";              # line ending for print
 378
 379         # all config-vars are by definition \w only, any \W means regex
 380         if ($qry =~ /\W/) {
 381             my @matches = config_re($qry);
 382             print map "$_$lnend", @matches ? @matches : "$qry: not found"               if !$notag;
 383             print map { s/\w+=//; "$_$lnend" } @matches ? @matches : "$qry: not found"  if  $notag;
 384         } else {
 385             my $v = (exists $Config{$qry}) ? $Config{$qry} : 'UNKNOWN';
 386             $v = 'undef' unless defined $v;
 387             print "${prfx}'${v}'$lnend";
 388         }
 389     }
 390 }
 391
 392 ENDOFEND
 393
 394 if ($^O eq 'os2') {
 395     print CONFIG <<'ENDOFSET';
 396 my %preconfig;
 397 if ($OS2::is_aout) {
 398     my ($value, $v) = $Config_SH =~ m/^used_aout='(.*)'\s*$/m;
 399     for (split ' ', $value) {
 400         ($v) = $Config_SH =~ m/^aout_$_='(.*)'\s*$/m;
 401         $preconfig{$_} = $v eq 'undef' ? undef : $v;
 402     }
 403 }
 404 $preconfig{d_fork} = undef unless $OS2::can_fork; # Some funny cases can't
 405 sub TIEHASH { bless {%preconfig} }
 406 ENDOFSET
 407     # Extract the name of the DLL from the makefile to avoid duplication
 408     my ($f) = grep -r, qw(GNUMakefile Makefile);
 409     my $dll;
 410     if (open my $fh, '<', $f) {
 411         while (<$fh>) {
 412             $dll = $1, last if /^PERL_DLL_BASE\s*=\s*(\S*)\s*$/;
 413         }
 414     }
 415     print CONFIG <<ENDOFSET if $dll;
 416 \$preconfig{dll_name} = '$dll';
 417 ENDOFSET
 418 } else {
 419     print CONFIG <<'ENDOFSET';
 420 sub TIEHASH {
 421     bless $_[1], $_[0];
 422 }
 423 ENDOFSET
 424 }
 425
 426 my $fast_config = join '', map { "    $_,\n" }
 427     sort values (%v_fast), 'byteorder => $byteorder' ;
 428
 429 print CONFIG sprintf <<'ENDOFTIE', $fast_config;
 430
 431 # avoid Config..Exporter..UNIVERSAL search for DESTROY then AUTOLOAD
 432 sub DESTROY { }
 433
 434 tie %%Config, 'Config', {
 435 %s
 436 };
 437
 438 1;
 439 ENDOFTIE
 440
 441
 442 open(CONFIG_POD, ">lib/Config.pod") or die "Can't open lib/Config.pod: $!";
 443 print CONFIG_POD <<'ENDOFTAIL';
 444 =head1 NAME
 445
 446 Config - access Perl configuration information
 447
 448 =head1 SYNOPSIS
 449
 450     use Config;
 451     if ($Config{usethreads}) {
 452         print "has thread support\n"
 453     }
 454
 455     use Config qw(myconfig config_sh config_vars config_re);
 456
 457     print myconfig();
 458
 459     print config_sh();
 460
 461     print config_re();
 462
 463     config_vars(qw(osname archname));
 464
 465
 466 =head1 DESCRIPTION
 467
 468 The Config module contains all the information that was available to
 469 the C<Configure> program at Perl build time (over 900 values).
 470
 471 Shell variables from the F<config.sh> file (written by Configure) are
 472 stored in the readonly-variable C<%Config>, indexed by their names.
 473
 474 Values stored in config.sh as 'undef' are returned as undefined
 475 values.  The perl C<exists> function can be used to check if a
 476 named variable exists.
 477
 478 =over 4
 479
 480 =item myconfig()
 481
 482 Returns a textual summary of the major perl configuration values.
 483 See also C<-V> in L<perlrun/Switches>.
 484
 485 =item config_sh()
 486
 487 Returns the entire perl configuration information in the form of the
 488 original config.sh shell variable assignment script.
 489
 490 =item config_re($regex)
 491
 492 Like config_sh() but returns, as a list, only the config entries who's
 493 names match the $regex.
 494
 495 =item config_vars(@names)
 496
 497 Prints to STDOUT the values of the named configuration variable. Each is
 498 printed on a separate line in the form:
 499
 500   name='value';
 501
 502 Names which are unknown are output as C<name='UNKNOWN';>.
 503 See also C<-V:name> in L<perlrun/Switches>.
 504
 505 =back
 506
 507 =head1 EXAMPLE
 508
 509 Here's a more sophisticated example of using %Config:
 510
 511     use Config;
 512     use strict;
 513
 514     my %sig_num;
 515     my @sig_name;
 516     unless($Config{sig_name} && $Config{sig_num}) {
 517         die "No sigs?";
 518     } else {
 519         my @names = split ' ', $Config{sig_name};
 520         @sig_num{@names} = split ' ', $Config{sig_num};
 521         foreach (@names) {
 522             $sig_name[$sig_num{$_}] ||= $_;
 523         }
 524     }
 525
 526     print "signal #17 = $sig_name[17]\n";
 527     if ($sig_num{ALRM}) {
 528         print "SIGALRM is $sig_num{ALRM}\n";
 529     }
 530
 531 =head1 WARNING
 532
 533 Because this information is not stored within the perl executable
 534 itself it is possible (but unlikely) that the information does not
 535 relate to the actual perl binary which is being used to access it.
 536
 537 The Config module is installed into the architecture and version
 538 specific library directory ($Config{installarchlib}) and it checks the
 539 perl version number when loaded.
 540
 541 The values stored in config.sh may be either single-quoted or
 542 double-quoted. Double-quoted strings are handy for those cases where you
 543 need to include escape sequences in the strings. To avoid runtime variable
 544 interpolation, any C<$> and C<@> characters are replaced by C<\$> and
 545 C<\@>, respectively. This isn't foolproof, of course, so don't embed C<\$>
 546 or C<\@> in double-quoted strings unless you're willing to deal with the
 547 consequences. (The slashes will end up escaped and the C<$> or C<@> will
 548 trigger variable interpolation)
 549
 550 =head1 GLOSSARY
 551
 552 Most C<Config> variables are determined by the C<Configure> script
 553 on platforms supported by it (which is most UNIX platforms).  Some
 554 platforms have custom-made C<Config> variables, and may thus not have
 555 some of the variables described below, or may have extraneous variables
 556 specific to that particular port.  See the port specific documentation
 557 in such cases.
 558
 559 ENDOFTAIL
 560
 561 if ($Opts{glossary}) {
 562   open(GLOS, "<$Glossary") or die "Can't open $Glossary: $!";
 563 }
 564 %seen = ();
 565 $text = 0;
 566 $/ = '';
 567
 568 sub process {
 569   if (s/\A(\w*)\s+\(([\w.]+)\):\s*\n(\t?)/=item C<$1>\n\nFrom F<$2>:\n\n/m) {
 570     my $c = substr $1, 0, 1;
 571     unless ($seen{$c}++) {
 572       print CONFIG_POD <<EOF if $text;
 573 =back
 574
 575 EOF
 576       print CONFIG_POD <<EOF;
 577 =head2 $c
 578
 579 =over 4
 580
 581 EOF
 582      $text = 1;
 583     }
 584   }
 585   elsif (!$text || !/\A\t/) {
 586     warn "Expected a Configure variable header",
 587       ($text ? " or another paragraph of description" : () );
 588   }
 589   s/n't/n\00t/g;                # leave can't, won't etc untouched
 590   s/^\t\s+(.*)/\n$1/gm;         # Indented lines ===> new paragraph
 591   s/^(?<!\n\n)\t(.*)/$1/gm;     # Not indented lines ===> text
 592   s{([\'\"])(?=[^\'\"\s]*[./][^\'\"\s]*\1)([^\'\"\s]+)\1}(F<$2>)g; # '.o'
 593   s{([\'\"])([^\'\"\s]+)\1}(C<$2>)g; # "date" command
 594   s{\'([A-Za-z_\- *=/]+)\'}(C<$1>)g; # 'ln -s'
 595   s{
 596      (?<! [\w./<\'\"] )         # Only standalone file names
 597      (?! e \. g \. )            # Not e.g.
 598      (?! \. \. \. )             # Not ...
 599      (?! \d )                   # Not 5.004
 600      (?! read/ )                # Not read/write
 601      (?! etc\. )                # Not etc.
 602      (?! I/O )                  # Not I/O
 603      (
 604         \$ ?                    # Allow leading $
 605         [\w./]* [./] [\w./]*    # Require . or / inside
 606      )
 607      (?<! \. (?= [\s)] ) )      # Do not include trailing dot
 608      (?! [\w/] )                # Include all of it
 609    }
 610    (F<$1>)xg;                   # /usr/local
 611   s/((?<=\s)~\w*)/F<$1>/g;      # ~name
 612   s/(?<![.<\'\"])\b([A-Z_]{2,})\b(?![\'\"])/C<$1>/g;    # UNISTD
 613   s/(?<![.<\'\"])\b(?!the\b)(\w+)\s+macro\b/C<$1> macro/g; # FILE_cnt macro
 614   s/n[\0]t/n't/g;               # undo can't, won't damage
 615 }
 616
 617 if ($Opts{glossary}) {
 618     <GLOS>;                             # Skip the "DO NOT EDIT"
 619     <GLOS>;                             # Skip the preamble
 620   while (<GLOS>) {
 621     process;
 622     print CONFIG_POD;
 623   }
 624 }
 625
 626 print CONFIG_POD <<'ENDOFTAIL';
 627
 628 =back
 629
 630 =head1 NOTE
 631
 632 This module contains a good example of how to use tie to implement a
 633 cache and an example of how to make a tied variable readonly to those
 634 outside of it.
 635
 636 =cut
 637
 638 ENDOFTAIL
 639
 640 close(CONFIG);
 641 close(GLOS);
 642 close(CONFIG_POD);
 643
 644 # Now create Cross.pm if needed
 645 if ($Opts{cross}) {
 646   open CROSS, ">lib/Cross.pm" or die "Can not open >lib/Cross.pm: $!";
 647   my $cross = <<'EOS';
 648 # typical invocation:
 649 #   perl -MCross Makefile.PL
 650 #   perl -MCross=wince -V:cc
 651 package Cross;
 652
 653 sub import {
 654   my ($package,$platform) = @_;
 655   unless (defined $platform) {
 656     # if $platform is not specified, then use last one when
 657     # 'configpm; was invoked with --cross option
 658     $platform = '***replace-marker***';
 659   }
 660   @INC = map {/\blib\b/?(do{local $_=$_;s/\blib\b/xlib\/$platform/;$_},$_):($_)} @INC;
 661   $::Cross::platform = $platform;
 662 }
 663
 664 1;
 665 EOS
 666   $cross =~ s/\*\*\*replace-marker\*\*\*/$Opts{cross}/g;
 667   print CROSS $cross;
 668   close CROSS;
 669 }
 670
 671 # Now do some simple tests on the Config.pm file we have created
 672 unshift(@INC,'lib');
 673 require $Config_PM;
 674 import Config;
 675
 676 die "$0: $Config_PM not valid"
 677         unless $Config{'PERL_CONFIG_SH'} eq 'true';
 678
 679 die "$0: error processing $Config_PM"
 680         if defined($Config{'an impossible name'})
 681         or $Config{'PERL_CONFIG_SH'} ne 'true' # test cache
 682         ;
 683
 684 die "$0: error processing $Config_PM"
 685         if eval '$Config{"cc"} = 1'
 686         or eval 'delete $Config{"cc"}'
 687         ;
 688
 689
 690 exit 0;