Generate the virtual entries at Config.pm build time, as they

don't change. This lets us get rid of the entire "fetch_virtual"
baggage, and makes the config_re lookup work for the virtual
entries.

p4raw-id: //depot/perl@23542

diff --git a/configpm b/configpm
index f1e4e97..061528c 100755 (executable)
--- a/configpm
+++ b/configpm
@@ -207,7 +207,7 @@ close CONFIG_SH;
 
 # Calculation for the keys for byteorder
 # This is somewhat grim, but I need to run fetch_string here.
-our $Config_SH_expanded = join "\n", @v_fast, @v_others;
+our $Config_SH_expanded = join "\n", '', @v_fast, @v_others;
 
 my $t = fetch_string ({}, 'ivtype');
 my $s = fetch_string ({}, 'ivsize');
@@ -267,60 +267,50 @@ print CONFIG <<'EOT';
 s/(byteorder=)(['"]).*?\2/$1$2$byteorder$2/m;
 our $Config_SH : unique = $_;
 
-our $Config_SH_expanded : unique = "\n$_";
+our $Config_SH_expanded : unique = "\n$_" . << 'EOVIRTUAL';
 EOT
 
-print CONFIG $fetch_string;
-
-print CONFIG <<'ENDOFEND';
-
-sub fetch_virtual {
-    my($self, $key) = @_;
+foreach my $prefix (qw(ccflags ldflags)) {
+    my $value = fetch_string ({}, $prefix);
+    my $withlargefiles = fetch_string ({}, $prefix . "_uselargefiles");
+    $value =~ s/\Q$withlargefiles\E\b//;
+    print CONFIG "${prefix}_nolargefiles='$value'\n";
+}
 
-    my $value;
-
-    if ($key =~ /^((?: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 $new_key = "${1}_uselargefiles";
-       $value = $Config{$1};
-       my $withlargefiles = $Config{$new_key};
-       if ($new_key =~ /^(?:cc|ld)flags_/) {
-           $value =~ s/\Q$withlargefiles\E\b//;
-       } elsif ($new_key =~ /^libs/) {
-           my @lflibswanted = split(' ', $Config{libswanted_uselargefiles});
-           if (@lflibswanted) {
-               my %lflibswanted;
-               @lflibswanted{@lflibswanted} = ();
-               if ($new_key =~ /^libs_/) {
-                   my @libs = grep { /^-l(.+)/ &&
-                                      not exists $lflibswanted{$1} }
-                                   split(' ', $Config{libs});
-                   $value = join(' ', @libs);
-               } elsif ($new_key =~ /^libswanted_/) {
-                   my @libswanted = grep { not exists $lflibswanted{$_} }
-                                         split(' ', $Config{libswanted});
-                   $value = join(' ', @libswanted);
-               }
-           }
+foreach my $prefix (qw(libs libswanted)) {
+    my $value = fetch_string ({}, $prefix);
+    my @lflibswanted
+       = split(' ', fetch_string ({}, 'libswanted_uselargefiles'));
+    if (@lflibswanted) {
+       my %lflibswanted;
+       @lflibswanted{@lflibswanted} = ();
+       if ($prefix eq 'libs') {
+           my @libs = grep { /^-l(.+)/ &&
+                            not exists $lflibswanted{$1} }
+                                   split(' ', fetch_string ({}, 'libs'));
+           $value = join(' ', @libs);
+       } else {
+           my @libswanted = grep { not exists $lflibswanted{$_} }
+                                 split(' ', fetch_string ({}, 'libswanted'));
+           $value = join(' ', @libswanted);
        }
     }
-
-    $self->{$key} = $value;
+    print CONFIG "${prefix}_nolargefiles='$value'\n";
 }
 
+print CONFIG "EOVIRTUAL\n";
+
+print CONFIG $fetch_string;
+
+print CONFIG <<'ENDOFEND';
+
 sub FETCH { 
     my($self, $key) = @_;
 
     # check for cached value (which may be undef so we use exists not defined)
     return $self->{$key} if exists $self->{$key};
 
-    $self->fetch_string($key);
-    return $self->{$key} if exists $self->{$key};
-    $self->fetch_virtual($key);
-
-    # Might not exist, in which undef is correct.
-    return $self->{$key};
+    return $self->fetch_string($key);
 }
  
 my $prevpos = 0;

diff --git a/lib/Config.t b/lib/Config.t
index 24e3cab..9828554 100644 (file)
--- a/lib/Config.t
+++ b/lib/Config.t
@@ -221,15 +221,9 @@ foreach my $pain ($first, @virtual) {
   my @result = $Config{$pain};
   is (scalar @result, 1, "single result for \$config('$pain')");
 
- TODO: {
-    local $TODO;
-    $TODO = "No regexp lookup for $pain yet"
-      unless $pain eq 'byteorder' or $pain eq $first;
-
-    @result = Config::config_re($pain);
-    is (scalar @result, 1, "single result for config_re('$pain')");
-    like ($result[0], qr/^$pain=(['"])$Config{$pain}\1$/, # grr '
-         "which is the expected result for $pain");
-  }
+  @result = Config::config_re($pain);
+  is (scalar @result, 1, "single result for config_re('$pain')");
+  like ($result[0], qr/^$pain=(['"])$Config{$pain}\1$/, # grr '
+       "which is the expected result for $pain");
 }