From: Nicholas Clark <nick@ccl4.org>
Date: Thu, 22 Jul 2004 10:51:48 +0000 (+0000)
Subject: Config::config_re and config_sh would report the byteorder as 'ffff'
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=8468119f6ee8085392e5c77b735fdba19cf0f08e;p=p5sagit%2Fp5-mst-13.2.git

Config::config_re and config_sh would report the byteorder as 'ffff'

p4raw-id: //depot/perl@23147
---

diff --git a/configpm b/configpm
index e27996f..e5f2c08 100755
--- a/configpm
+++ b/configpm
@@ -210,6 +210,34 @@ while (<CONFIG_SH>) {
 }
 close CONFIG_SH;
 
+# Calculation for the keys for byteorder
+# This is somewhat grim, but I need to run fetch_string here.
+our $Config_SH = join "\n", @v_fast, @v_others;
+
+my $t = fetch_string ({}, 'ivtype');
+my $s = fetch_string ({}, 'ivsize');
+
+# byteorder does exist on its own but we overlay a virtual
+# dynamically recomputed value.
+
+# However, ivtype and ivsize will not vary for sane fat binaries
+
+my $f = $t eq 'long' ? 'L!' : $s == 8 ? 'Q': 'I';
+
+my $byteorder_code;
+if ($s == 4 || $s == 8) {
+    my $list = join ',', reverse(2..$s);
+    my $format = 'a'x$s;
+    $byteorder_code = <<"EOT";
+my \$i = 0;
+foreach my \$c ($list) { \$i |= ord(\$c); \$i <<= 8 }
+\$i |= ord(1);
+my \$byteorder = join('', unpack('$format', pack('$f', \$i)));
+EOT
+} else {
+    $byteorder_code = "my \$byteorder = '?'x$s;\n";
+}
+
 print CONFIG @non_v, "\n";
 
 # copy config summary format from the myconfig.SH script
@@ -223,7 +251,7 @@ close(MYCONFIG);
 # before expanding it, because may have been made readonly if a perl
 # interpreter has been cloned.
 
-print CONFIG "\n!END!\n", <<'EOT';
+print CONFIG "\n!END!\n", $byteorder_code, <<'EOT';
 my $summary_expanded;
 
 sub myconfig {
@@ -233,12 +261,19 @@ sub myconfig {
     $summary_expanded;
 }
 
-our $Config_SH : unique = <<'!END!';
+local *_ = \my $a;
+$_ = <<'!END!';
 EOT
 
 print CONFIG join("", @v_fast, sort @v_others);
 
-print CONFIG "!END!\n", $fetch_string;
+print CONFIG <<'EOT';
+!END!
+s/(byteorder=)(['"]).*?\2/$1$2$byteorder$2/m;
+our $Config_SH : unique = $_;
+EOT
+
+print CONFIG $fetch_string;
 
 print CONFIG <<'ENDOFEND';
 
@@ -384,45 +419,14 @@ sub TIEHASH {
 ENDOFSET
 }
 
-
-# Calculation for the keys for byteorder
-# This is somewhat grim, but I need to run fetch_string here.
-our $Config_SH = join "\n", @v_fast, @v_others;
-
-my $t = fetch_string ({}, 'ivtype');
-my $s = fetch_string ({}, 'ivsize');
-
-# byteorder does exist on its own but we overlay a virtual
-# dynamically recomputed value.
-
-# However, ivtype and ivsize will not vary for sane fat binaries
-
-my $f = $t eq 'long' ? 'L!' : $s == 8 ? 'Q': 'I';
-
-my $byteorder_code;
-if ($s == 4 || $s == 8) {
-    my $list = join ',', reverse(2..$s);
-    my $format = 'a'x$s;
-    $byteorder_code = <<"EOT";
-my \$i = 0;
-foreach my \$c ($list) { \$i |= ord(\$c); \$i <<= 8 }
-\$i |= ord(1);
-my \$value = join('', unpack('$format', pack('$f', \$i)));
-EOT
-} else {
-    $byteorder_code = "\$value = '?'x$s;\n";
-}
-
 my $fast_config = join '', map { "    $_,\n" }
-    sort values (%v_fast), 'byteorder => $value' ;
+    sort values (%v_fast), 'byteorder => $byteorder' ;
 
-print CONFIG sprintf <<'ENDOFTIE', $byteorder_code, $fast_config;
+print CONFIG sprintf <<'ENDOFTIE', $fast_config;
 
 # avoid Config..Exporter..UNIVERSAL search for DESTROY then AUTOLOAD
 sub DESTROY { }
 
-%s
-
 tie %%Config, 'Config', {
 %s
 };
diff --git a/lib/Config.t b/lib/Config.t
index 68979c1..38acde6 100644
--- a/lib/Config.t
+++ b/lib/Config.t
@@ -62,8 +62,10 @@ ok(exists $Config{ccflags_nolargefiles}, "has ccflags_nolargefiles");
     }
 }
 
-like(Config::myconfig(),       qr/osname=\Q$Config{osname}\E/,   "myconfig");
-like(Config::config_sh(),      qr/osname='\Q$Config{osname}\E'/, "config_sh");
+like(Config::myconfig(), qr/osname=\Q$Config{osname}\E/,   "myconfig");
+like(Config::config_sh(), qr/osname='\Q$Config{osname}\E'/, "config_sh");
+like(Config::config_sh(), qr/byteorder='[1-8]+'/,
+     "config_sh has a valid byteorder");
 foreach my $line (Config::config_re('c.*')) {
   like($line,                  qr/^c.*?=.*$/,                   'config_re' );
 }
@@ -156,3 +158,12 @@ ok( exists $Config{d_fork}, "still d_fork");
 
 is($Config{sig_num_init}  =~ tr/,/,/, $Config{sig_size}, "sig_num_init size");
 is($Config{sig_name_init} =~ tr/,/,/, $Config{sig_size}, "sig_name_init size");
+
+# Test the troublesome virtual stuff
+foreach my $pain (qw(byteorder)) {
+  # No config var is named with anything that is a regexp metachar"
+  my @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");
+}