1#!./perl -w 2BEGIN { 3 chdir ".." if -e "./test.pl"; 4 push @INC, "lib"; 5} 6use strict; 7require './t/test.pl'; 8skip_all("Sorting order differs under EBCDIC") if $::IS_EBCDIC || $::IS_EBCDIC; 9 10use Config; 11 12my %legacy_different = ( 13 # define # string 14 'VMS_WE_ARE_CASE_SENSITIVE' => 'VMS_SYMBOL_CASE_AS_IS', 15 'WIN32_NO_REGISTRY' => 'USE_NO_REGISTRY', 16); 17 18# As we need to call it direct, we'll take advantage of its result ordering: 19my @to_check = qw(bincompat_options non_bincompat_options); 20my @file = qw(perl.h perl.c); 21my @var = qw(PL_bincompat_options non_bincompat_options); 22my @V = map {s/^ //r} Internals::V(); 23 24while (my ($index, $sub) = each @to_check) { 25 my $got = join ' ', sort &{Config->can($sub)}(); 26 is($got, $V[$index], "C source code has $sub in sorted order"); 27 open my $fh, "<", $file[$index] 28 or die "Failed to open '$file[$index]': $!"; 29 my @strs; 30 my @define; 31 while (<$fh>) { 32 if (/$var[$index]\[\]\s*=/ .. /^\s*"";/) { 33 if (/ifdef\s+(\w+)/) { 34 my $name = $1; 35 # ignore PERL_HASH_ vars as they are handled differently 36 # from the rest. 37 $name=~/PERL_HASH_/ and next; 38 push @define, $name; 39 } 40 elsif (/" ([^"]+)"/) { 41 my $name = $1; 42 # ignore PERL_HASH_ vars as they are handled differently 43 # from the rest. 44 $name=~/PERL_HASH_/ and next; 45 push @strs, $name; 46 } 47 } 48 } 49 foreach my $j (0 .. $#strs) { 50 my $want = $legacy_different{$define[$j]} || $define[$j]; 51 my $str = $strs[$j]; 52 is($strs[$j],$want, "String and define $j are the same ($strs[$j]) for $var[$index] in $file[$index]"); 53 } 54 my @sorted_strs = sort @strs; 55 is("@strs","@sorted_strs", "Strings are sorted for $var[$index] in $file[$index]"); 56} 57 58done_testing(); 59