This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
d_Gconvert hints and Glossary
[perl5.git] / configpm
index dd9e858..d8339fa 100755 (executable)
--- a/configpm
+++ b/configpm
@@ -17,17 +17,33 @@ my $glossary = $ARGV[1] || 'Porting/Glossary';
 
 
 open CONFIG, ">$config_pm" or die "Can't open $config_pm: $!\n";
-$myver = $];
+$myver = sprintf "v%vd", $^V;
 
-print CONFIG <<"ENDOFBEG";
+print CONFIG <<'ENDOFBEG_NOQ', <<"ENDOFBEG";
 package Config;
 use Exporter ();
-\@ISA = (Exporter);
-\@EXPORT = qw(%Config);
-\@EXPORT_OK = qw(myconfig config_sh config_vars);
+@EXPORT = qw(%Config);
+@EXPORT_OK = qw(myconfig config_sh config_vars);
+
+# Define our own import method to avoid pulling in the full Exporter:
+sub import {
+  my $pkg = shift;
+  @_ = @EXPORT unless @_;
+  my @func = grep {$_ ne '%Config'} @_;
+  local $Exporter::ExportLevel = 1;
+  Exporter::import('Config', @func) if @func;
+  return if @func == @_;
+  my $callpkg = caller(0);
+  *{"$callpkg\::Config"} = \%Config;
+}
+
+ENDOFBEG_NOQ
+die "Perl lib version ($myver) doesn't match executable version (\$])"
+    unless \$^V;
 
-\$] == $myver
-  or die "Perl lib version ($myver) doesn't match executable version (\$])";
+\$^V eq $myver
+  or die "Perl lib version ($myver) doesn't match executable version (" .
+    (sprintf "v%vd",\$^V) . ")";
 
 # This file was created by configpm when Perl was built. Any changes
 # made to this file will be lost the next time perl is built.
@@ -44,7 +60,7 @@ $in_v = 0;
 
 while (<>) {
     next if m:^#!/bin/sh:;
-    # Catch CONFIGDOTSH=true and PERL_VERSION=n line from Configure.
+    # Catch PERL_CONFIG_SH=true and PERL_VERSION=n line from Configure.
     s/^(\w+)=(true|\d+)\s*$/$1='$2'\n/;
     my ($k,$v) = ($1,$2);
     # grandfather PATCHLEVEL and SUBVERSION and CONFIG
@@ -55,7 +71,7 @@ while (<>) {
        elsif ($k eq 'PERL_SUBVERSION') {
            push @v_others, "SUBVERSION='$v'\n";
        }
-       elsif ($k eq 'CONFIGDOTSH') {
+       elsif ($k eq 'PERL_CONFIG_SH') {
            push @v_others, "CONFIG='$v'\n";
        }
     }
@@ -112,41 +128,84 @@ sub FETCH {
 
     # Search for it in the big string 
     my($value, $start, $marker, $quote_type);
-    $marker = "$_[1]=";
+
     $quote_type = "'";
-    # return undef unless (($value) = $config_sh =~ m/^$_[1]='(.*)'\s*$/m);
-    # Check for the common case, ' delimeted
-    $start = index($config_sh, "\n$marker$quote_type");
-    # If that failed, check for " delimited
-    if ($start == -1) {
-      $quote_type = '"';
-      $start = index($config_sh, "\n$marker$quote_type");
-    }
-    return undef if ( ($start == -1) &&  # in case it's first 
-        (substr($config_sh, 0, length($marker)) ne $marker) );
-    if ($start == -1) { 
-      # It's the very first thing we found. Skip $start forward
-      # and figure out the quote mark after the =.
-      $start = length($marker) + 1;
-      $quote_type = substr($config_sh, $start - 1, 1);
-    } 
-    else { 
-      $start += length($marker) + 2;
+    # Virtual entries.
+    if ($_[1] eq 'byteorder') {
+       # byteorder does exist on its own but we overlay a virtual
+       # dynamically recomputed value. 
+        my $t = $Config{ivtype};
+        my $s = $Config{ivsize};
+        my $f = $t eq 'long' ? 'L!' : $s == 8 ? 'Q': 'I';
+        if ($s == 4 || $s == 8) {
+           my $i = 0;
+           foreach my $c (reverse(2..$s)) { $i |= ord($c); $i <<= 8 }
+           $i |= ord(1);
+            $value = join('', unpack('a'x$s, pack($f, $i)));
+        } else {
+            $value = '?'x$s;
+        }
+    } elsif ($_[1] =~ /^((?:cc|ld)flags|libs(?:wanted)?)_nolargefiles/) {
+       # These are purely virtual, they do not exist, but need to
+       # be computed on demand for largefile-incapable extensions.
+       my $key = "${1}_uselargefiles";
+       $value = $Config{$1};
+       my $withlargefiles = $Config{$key};
+       if ($key =~ /^(?:cc|ld)flags_/) {
+           $value =~ s/\Q$withlargefiles\E\b//;
+       } elsif ($key =~ /^libs/) {
+           my @lflibswanted = split(' ', $Config{libswanted_uselargefiles});
+           if (@lflibswanted) {
+               my %lflibswanted;
+               @lflibswanted{@lflibswanted} = ();
+               if ($key =~ /^libs_/) {
+                   my @libs = grep { /^-l(.+)/ &&
+                                      not exists $lflibswanted{$1} }
+                                   split(' ', $Config{libs});
+                   $Config{libs} = join(' ', @libs);
+               } elsif ($key =~ /^libswanted_/) {
+                   my @libswanted = grep { not exists $lflibswanted{$_} }
+                                         split(' ', $Config{libswanted});
+                   $Config{libswanted} = join(' ', @libswanted);
+               }
+           }
+       }
+    } else {
+       $marker = "$_[1]=";
+       # return undef unless (($value) = $config_sh =~ m/^$_[1]='(.*)'\s*$/m);
+       # Check for the common case, ' delimeted
+       $start = index($config_sh, "\n$marker$quote_type");
+       # If that failed, check for " delimited
+       if ($start == -1) {
+           $quote_type = '"';
+           $start = index($config_sh, "\n$marker$quote_type");
+       }
+       return undef if ( ($start == -1) &&  # in case it's first 
+                         (substr($config_sh, 0, length($marker)) ne $marker) );
+       if ($start == -1) { 
+           # It's the very first thing we found. Skip $start forward
+           # and figure out the quote mark after the =.
+           $start = length($marker) + 1;
+           $quote_type = substr($config_sh, $start - 1, 1);
+       } 
+       else { 
+           $start += length($marker) + 2;
+       }
+       $value = substr($config_sh, $start, 
+                       index($config_sh, "$quote_type\n", $start) - $start);
     }
-    $value = substr($config_sh, $start, 
-        index($config_sh, "$quote_type\n", $start) - $start);
     # If we had a double-quote, we'd better eval it so escape
     # sequences and such can be interpolated. Since the incoming
     # value is supposed to follow shell rules and not perl rules,
     # we escape any perl variable markers
     if ($quote_type eq '"') {
-      $value =~ s/\$/\\\$/g;
-      $value =~ s/\@/\\\@/g;
-      eval "\$value = \"$value\"";
+       $value =~ s/\$/\\\$/g;
+       $value =~ s/\@/\\\@/g;
+       eval "\$value = \"$value\"";
     }
     #$value = sprintf($value) if $quote_type eq '"';
-    $value = undef if $value eq 'undef'; # So we can say "if $Config{'foo'}".
+    # So we can say "if $Config{'foo'}".
+    $value = undef if $value eq 'undef';
     $_[0]->{$_[1]} = $value; # cache it
     return $value;
 }
@@ -175,7 +234,8 @@ sub EXISTS {
     index($config_sh, "\n$_[1]='") != -1 or
     substr($config_sh, 0, length($_[1])+2) eq "$_[1]='" or
     index($config_sh, "\n$_[1]=\"") != -1 or
-    substr($config_sh, 0, length($_[1])+2) eq "$_[1]=\"";
+    substr($config_sh, 0, length($_[1])+2) eq "$_[1]=\"" or
+    $_[1] =~ /^(?:(?:cc|ld)flags|libs(?:wanted)?)_nolargefiles$/;
 }
 
 sub STORE  { die "\%Config::Config is read-only\n" }
@@ -189,7 +249,7 @@ sub config_sh {
 
 sub config_re {
     my $re = shift;
-    my @matches = ($config_sh =~ /^$re=.*\n/mg);
+    my @matches = grep /^$re=/, split /^/, $config_sh;
     @matches ? (print @matches) : print "$re: not found\n";
 }
 
@@ -214,8 +274,20 @@ if ($OS2::is_aout) {
         $preconfig{$_} = $v eq 'undef' ? undef : $v;
     }
 }
+$preconfig{d_fork} = undef unless $OS2::can_fork; # Some funny cases can't
 sub TIEHASH { bless {%preconfig} }
 ENDOFSET
+  # Extract the name of the DLL from the makefile to avoid duplication
+  my ($f) = grep -r, qw(GNUMakefile Makefile);
+  my $dll;
+  if (open my $fh, '<', $f) {
+    while (<$fh>) {
+      $dll = $1, last if /^PERL_DLL_BASE\s*=\s*(\S*)\s*$/;
+    }
+  }
+  print CONFIG <<ENDOFSET if $dll;
+\$preconfig{dll_name} = '$dll';
+ENDOFSET
 } else {
   print CONFIG <<'ENDOFSET';
 sub TIEHASH { bless {} }
@@ -348,20 +420,25 @@ $text = 0;
 $/ = '';
 
 sub process {
-  s/\A(\w*)\s+\(([\w.]+)\):\s*\n(\t?)/=item C<$1>\n\nFrom F<$2>:\n\n/m;
-  my $c = substr $1, 0, 1;
-  unless ($seen{$c}++) {
-    print CONFIG <<EOF if $text;
+  if (s/\A(\w*)\s+\(([\w.]+)\):\s*\n(\t?)/=item C<$1>\n\nFrom F<$2>:\n\n/m) {
+    my $c = substr $1, 0, 1;
+    unless ($seen{$c}++) {
+      print CONFIG <<EOF if $text;
 =back
 
 EOF
-    print CONFIG <<EOF;
+      print CONFIG <<EOF;
 =head2 $c
 
-=over
+=over 4
 
 EOF
-    $text = 1;
+     $text = 1;
+    }
+  }
+  elsif (!$text || !/\A\t/) {
+    warn "Expected a Configure variable header",
+      ($text ? " or another paragraph of description" : () );
   }
   s/n't/n\00t/g;               # leave can't, won't etc untouched
   s/^\t\s+(.*)/\n\t$1\n/gm;    # Indented lines ===> paragraphs
@@ -414,11 +491,11 @@ require $config_pm;
 import Config;
 
 die "$0: $config_pm not valid"
-       unless $Config{'CONFIGDOTSH'} eq 'true';
+       unless $Config{'PERL_CONFIG_SH'} eq 'true';
 
 die "$0: error processing $config_pm"
        if defined($Config{'an impossible name'})
-       or $Config{'CONFIGDOTSH'} ne 'true' # test cache
+       or $Config{'PERL_CONFIG_SH'} ne 'true' # test cache
        ;
 
 die "$0: error processing $config_pm"