t/porting/bincompat.t - test the code itself not just the output

Our checks on the define info we expose via Internals::V(), especially
the sorted part, did not really work properly as it only checked defines
that are actually exposed in our standard builds.  Many of the defines
that are exposed in this list are special cases that would not be
enabled in a normal build we test under CI, and indeed prior to this
patch it was possible for us to produce unsorted output if certain
defines were enabled.

This patch adds checks that reads the actual code.  It checks that the
define and the string are the same, and it checks that strings would be
output in sorted order assuming every define was enabled.

There are two historical exceptions where the string we show and the
define use internally are different, but we work around these two cases
with as special case hash.

3 files changed, 52 insertions, 12 deletions

diff --git a/perl.c b/perl.c
index abd8877fc9..a8d92aef77 100644
--- a/perl.c
+++ b/perl.c
@@ -1995,6 +1995,12 @@ S_Internals_V(pTHX_ CV *cv)
 #  ifdef NO_MATHOMS
                              " NO_MATHOMS"
 #  endif
+#  ifdef NO_PERL_INTERNAL_RAND_SEED
+                             " NO_PERL_INTERNAL_RAND_SEED"
+#  endif
+#  ifdef NO_PERL_RAND_SEED
+                             " NO_PERL_RAND_SEED"
+#  endif
 #  ifdef NO_TAINT_SUPPORT
                              " NO_TAINT_SUPPORT"
 #  endif
@@ -2080,13 +2086,8 @@ S_Internals_V(pTHX_ CV *cv)
 #  ifdef USE_THREAD_SAFE_LOCALE
                              " USE_THREAD_SAFE_LOCALE"
 #  endif
-#  ifdef NO_PERL_RAND_SEED
-                             " NO_PERL_RAND_SEED"
-#  endif
-#  ifdef NO_PERL_INTERNAL_RAND_SEED
-                             " NO_PERL_INTERNAL_RAND_SEED"
-#  endif
-        ;
+    ""; /* keep this on a line by itself, WITH the empty string */
+
     PERL_UNUSED_ARG(cv);
     PERL_UNUSED_VAR(items);
 
diff --git a/perl.h b/perl.h
index c0440498b2..4ef161db95 100644
--- a/perl.h
+++ b/perl.h
@@ -5823,7 +5823,7 @@ EXTCONST char PL_bincompat_options[] =
 #  ifdef VMS_WE_ARE_CASE_SENSITIVE
                              " VMS_SYMBOL_CASE_AS_IS"
 #  endif
-  "";
+    ""; /* keep this on a line by itself, WITH the empty string */
 #else
 EXTCONST char PL_bincompat_options[];
 #endif
diff --git a/t/porting/bincompat.t b/t/porting/bincompat.t
index 01b52b24d5..dd9ade20c0 100644
--- a/t/porting/bincompat.t
+++ b/t/porting/bincompat.t
@@ -1,19 +1,58 @@
 #!./perl -w
+BEGIN {
+    chdir ".." if -e "./test.pl";
+    push @INC, "lib";
+}
 use strict;
-require './test.pl';
+require './t/test.pl';
 skip_all("Sorting order differs under EBCDIC") if $::IS_EBCDIC || $::IS_EBCDIC;
 
 use Config;
 
-plan(2);
-
-# Defiantly a white box test...
+my %legacy_different = (
+    # define                       # string
+    'VMS_WE_ARE_CASE_SENSITIVE' => 'VMS_SYMBOL_CASE_AS_IS',
+    'WIN32_NO_REGISTRY'         => 'USE_NO_REGISTRY',
+);
 
 # As we need to call it direct, we'll take advantage of its result ordering:
 my @to_check = qw(bincompat_options non_bincompat_options);
+my @file = qw(perl.h perl.c);
+my @var = qw(PL_bincompat_options non_bincompat_options);
 my @V = map {s/^ //r} Internals::V();
 
 while (my ($index, $sub) = each @to_check) {
     my $got = join ' ', sort &{Config->can($sub)}();
     is($got, $V[$index], "C source code has $sub in sorted order");
+    open my $fh, "<", $file[$index]
+        or die "Failed to open '$file[$index]': $!";
+    my @strs;
+    my @define;
+    while (<$fh>) {
+        if (/$var[$index]\[\]\s*=/ .. /^\s*"";/) {
+            if (/ifdef\s+(\w+)/) {
+                my $name = $1;
+                # ignore PERL_HASH_ vars as they are handled differently
+                # from the rest.
+                $name=~/PERL_HASH_/ and next;
+                push @define, $name;
+            }
+            elsif (/" ([^"]+)"/) {
+                my $name = $1;
+                # ignore PERL_HASH_ vars as they are handled differently
+                # from the rest.
+                $name=~/PERL_HASH_/ and next;
+                push @strs, $name;
+            }
+        }
+    }
+    foreach my $j (0 .. $#strs) {
+        my $want = $legacy_different{$define[$j]} || $define[$j];
+        my $str = $strs[$j];
+        is($strs[$j],$want, "String and define $j are the same ($strs[$j]) for $var[$index] in $file[$index]");
+    }
+    my @sorted_strs = sort @strs;
+    is("@strs","@sorted_strs", "Strings are sorted for $var[$index] in $file[$index]");
 }
+
+done_testing();