[perl5.git] / t / porting / libperl.t

#!/usr/bin/perl -w

# Try opening libperl.a with nm, and verifying it has the kind of symbols
# we expected.  Fail softly, expect things only on known platforms.
#
# Also, if the rarely-used builds options -DPERL_GLOBAL_STRUCT or
# -DPERL_GLOBAL_STRUCT_PRIVATE are used, verify that they did what
# they were meant to do, hide the global variables (see perlguts for
# the details).
#
# Debugging tip: nm output (this script's input) can be faked by
# giving one command line argument for this script: it should be
# either the filename to read, or "-" for STDIN.

BEGIN {
    chdir 't' if -d 't';
    @INC = '../lib';
    require "./test.pl";
}

use strict;

use Config;

if ($Config{cc} =~ /g\+\+/) {
    # XXX Could use c++filt, maybe.
    skip_all "on g++";
}

my $libperl_a;

for my $f (qw(../libperl.a libperl.a)) {
  if (-f $f) {
    $libperl_a = $f;
    last;
  }
}

unless (defined $libperl_a) {
  skip_all "no libperl.a";
}

print "# \$^O = $^O\n";
print "# \$Config{cc} = $Config{cc}\n";
print "# libperl = $libperl_a\n";

my $nm;
my $nm_opt = '';
my $nm_style;

if ($^O eq 'linux') {
    $nm = '/usr/bin/nm';
    $nm_style = 'gnu';
} elsif ($^O eq 'darwin') {
    $nm = '/usr/bin/nm';
    $nm_style = 'darwin';
    # With the -m option we get better information than the BSD-like
    # default: with the default, a lot of symbols get dumped into 'S'
    # or 's', for example one cannot tell the difference between const
    # and non-const symbols.
    $nm_opt = '-m';
}

unless (defined $nm) {
  skip_all "no nm";
}

unless (defined $nm_style) {
  skip_all "no nm style";
}

print "# nm = $nm\n";
print "# nm_style = $nm_style\n";
print "# nm_opt = $nm_opt\n";

unless (-x $nm) {
    skip_all "no executable nm $nm";
}

if ($nm_style eq 'gnu') {
    open(my $nm_fh, "$nm --version|") or
        skip_all "nm failed: $!";
    my $gnu_verified;
    while (<$nm_fh>) {
        if (/^GNU nm/) {
            $gnu_verified = 1;
            last;
        }
    }
    unless ($gnu_verified) {
        skip_all "no GNU nm";
    }
}

my $nm_err_tmp = "libperl$$";

END {
    # this is still executed when we skip_all above, avoid a warning
    unlink $nm_err_tmp if $nm_err_tmp;
}

my $nm_fh;

if (@ARGV == 1) {
    my $fake = shift @ARGV;
    print "# Faking nm output from $fake\n";
    if ($fake eq '-') {
        open($nm_fh, "<&STDIN") or
            skip_all "Duping STDIN failed: $!";
    } else {
        open($nm_fh, "<", $fake) or
            skip_all "Opening '$fake' failed: $!";
    }
    undef $nm_err_tmp; # In this case there will be no nm errors.
} else {
    open($nm_fh, "$nm $nm_opt $libperl_a 2>$nm_err_tmp |") or
        skip_all "$nm $nm_opt $libperl_a failed: $!";
}
 
sub nm_parse_gnu {
    my $symbols = shift;
    my $line = $_;
    if (m{^(\w+\.o):$}) {
        $symbols->{obj}{$1}++;
        $symbols->{o} = $1;
        return;
    } else {
        die "$0: undefined current object: $line"
            unless defined $symbols->{o};
        if (s/^[0-9a-f]{8}(?:[0-9a-f]{8})? //) {
            if (/^[Rr] (\w+)$/) {
                $symbols->{data}{const}{$1}{$symbols->{o}}++;
            } elsif (/^r .+$/) {
                # Skip local const.
            } elsif (/^[Tti] (\w+)(\..+)?$/) {
                $symbols->{text}{$1}{$symbols->{o}}++;
            } elsif (/^C (\w+)$/) {
                $symbols->{data}{common}{$1}{$symbols->{o}}++;
            } elsif (/^[BbSs] (\w+)(\.\d+)?$/) {
                $symbols->{data}{bss}{$1}{$symbols->{o}}++;
            } elsif (/^0{16} D _LIB_VERSION$/) {
                # Skip the _LIB_VERSION (not ours).
            } elsif (/^[DdGg] (\w+)$/) {
                $symbols->{data}{data}{$1}{$symbols->{o}}++;
            } elsif (/^. \.?(\w+)$/) {
                # Skip the unknown types.
                print "# Unknown type: $line ($symbols->{o})\n";
            }
            return;
        } elsif (/^ {8}(?: {8})? U (\w+)$/) {
            # Skip the undefined.
            return;
	}
    }
    print "# Unexpected nm output '$line' ($symbols->{o})\n";
}

sub nm_parse_darwin {
    my $symbols = shift;
    my $line = $_;
    if (m{^(?:\.\./)?libperl\.a\((\w+\.o)\):$}) {
        $symbols->{obj}{$1}++;
        $symbols->{o} = $1;
        return;
    } else {
        die "$0: undefined current object: $line" unless defined $symbols->{o};
        if (s/^[0-9a-f]{8}(?:[0-9a-f]{8})? //) {
            if (/^\(__TEXT,__(?:const|cstring|literal\d+)\) (?:non-)?external _?(\w+)(\.\w+)?$/) {
                my ($symbol, $suffix) = ($1, $2);
                # Ignore function-local constants like
                # _Perl_av_extend_guts.oom_array_extend
                return if defined $suffix && /__TEXT,__const/;
                # Ignore the cstring unnamed strings.
                return if $symbol =~ /^L\.str\d+$/;
                $symbols->{data}{const}{$symbol}{$symbols->{o}}++;
            } elsif (/^\(__TEXT,__text\) (?:non-)?external _(\w+)$/) {
                $symbols->{text}{$1}{$symbols->{o}}++;
            } elsif (/^\(__DATA,__(const|data|bss|common)\) (?:non-)?external _(\w+)(\.\w+)?$/) {
                my ($dtype, $symbol, $suffix) = ($1, $2, $3);
                # Ignore function-local constants like
                # _Perl_pp_gmtime.dayname
                return if defined $suffix;
                $symbols->{data}{$dtype}{$symbol}{$symbols->{o}}++;
            } elsif (/^\(__DATA,__const\) non-external _\.memset_pattern\d*$/) {
                # Skip this, whatever it is (some inlined leakage from
                # darwin libc?)
            } elsif (/^\(__TEXT,__eh_frame/) {
                # Skip the eh_frame symbols.
                return;
            } elsif (/^\(__\w+,__\w+\) /) {
                # Skip the unknown types.
                print "# Unknown type: $line ($symbols->{o})\n";
            }
            return;
        } elsif (/^ {8}(?: {8})? \(undefined\) /) {
            # Skip the undefined.
            return;
        }
    }
    print "# Unexpected nm output '$line' ($symbols->{o})\n";
}

my $nm_parse;

if ($nm_style eq 'gnu') {
    $nm_parse = \&nm_parse_gnu;
} elsif ($nm_style eq 'darwin') {
    $nm_parse = \&nm_parse_darwin;
}

unless (defined $nm_parse) {
    skip_all "no nm parser ($nm_style $nm_style, \$^O $^O)";
}

my %symbols;

while (<$nm_fh>) {
    next if /^$/;
    chomp;
    $nm_parse->(\%symbols);
}

# use Data::Dumper; print Dumper(\%symbols);

if (keys %symbols == 0) {
    skip_all "no symbols\n";
}

# These should always be true for everyone.

ok($symbols{obj}{'pp.o'}, "has object pp.o");
ok($symbols{text}{'Perl_peep'}, "has text Perl_peep");
ok($symbols{text}{'Perl_pp_uc'}{'pp.o'}, "has text Perl_pp_uc in pp.o");
ok(exists $symbols{data}{const}, "has data const symbols");
ok($symbols{data}{const}{PL_no_mem}{'globals.o'}, "has PL_no_mem");

my $DEBUGGING = $Config{ccflags} =~ /-DDEBUGGING/ ? 1 : 0;

my $GS  = $Config{ccflags} =~ /-DPERL_GLOBAL_STRUCT\b/ ? 1 : 0;
my $GSP = $Config{ccflags} =~ /-DPERL_GLOBAL_STRUCT_PRIVATE/ ? 1 : 0;

print "# GS  = $GS\n";
print "# GSP = $GSP\n";

my %data_symbols;

for my $dtype (sort keys %{$symbols{data}}) {
    for my $symbol (sort keys %{$symbols{data}{$dtype}}) {
        $data_symbols{$symbol}++;
    }
}

# The following tests differ between vanilla vs $GSP or $GS.
#
# Some terminology:
# - "text" symbols are code
# - "data" symbols are data (duh), with subdivisions:
#   - "bss": (Block-Started-by-Symbol: originally from IBM assembler...),
#     uninitialized data, which often even doesn't exist in the object
#     file as such, only its size does, which is then created on demand
#     by the loader
#  - "const": initialized read-only data, like string literals
#  - "common": uninitialized data unless initialized...
#    (the full story is too long for here, see "man nm")
#  - "data": initialized read-write data
#    (somewhat confusingly below: "data data", but it makes code simpler)

if ($GSP) {
    print "# -DPERL_GLOBAL_STRUCT_PRIVATE\n";
    ok(!exists $data_symbols{PL_hash_seed}, "has no PL_hash_seed");
    ok(!exists $data_symbols{PL_ppaddr}, "has no PL_ppaddr");

    ok(! exists $symbols{data}{bss}, "has no data bss symbols");
    ok(! exists $symbols{data}{data} ||
            # clang with ASAN seems to add this symbol to every object file:
            !grep($_ ne '__unnamed_1', keys %{$symbols{data}{data}}),
        "has no data data symbols");
    ok(! exists $symbols{data}{common}, "has no data common symbols");

    # -DPERL_GLOBAL_STRUCT_PRIVATE should NOT have
    # the extra text symbol for accessing the vars
    # (as opposed to "just" -DPERL_GLOBAL_STRUCT)
    ok(! exists $symbols{text}{Perl_GetVars}, "has no Perl_GetVars");
} elsif ($GS) {
    print "# -DPERL_GLOBAL_STRUCT\n";
    ok(!exists $data_symbols{PL_hash_seed}, "has no PL_hash_seed");
    ok(!exists $data_symbols{PL_ppaddr}, "has no PL_ppaddr");

    ok(! exists $symbols{data}{bss}, "has no data bss symbols");

    # These PerlIO data symbols are left visible with
    # -DPERL_GLOBAL_STRUCT (as opposed to -DPERL_GLOBAL_STRUCT_PRIVATE)
    my @PerlIO =
        qw(
           PerlIO_byte
           PerlIO_crlf
           PerlIO_pending
           PerlIO_perlio
           PerlIO_raw
           PerlIO_remove
           PerlIO_stdio
           PerlIO_unix
           PerlIO_utf8
          );

    # PL_magic_vtables is const with -DPERL_GLOBAL_STRUCT_PRIVATE but
    # otherwise not const -- because of SWIG which wants to modify
    # the table.  Evil SWIG, eeevil.

    # my_cxt_index is used with PERL_IMPLICIT_CONTEXT, which
    # -DPERL_GLOBAL_STRUCT has turned on.
    eq_array([sort keys %{$symbols{data}{data}}],
             [sort('PL_VarsPtr',
                   @PerlIO,
                   'PL_magic_vtables',
                   'my_cxt_index')],
             "data data symbols");

    # Only one data common symbol, our "supervariable".
    eq_array([sort keys %{$symbols{data}{common}}],
             ['PL_Vars'],
             "data common symbols");

    ok($symbols{data}{data}{PL_VarsPtr}{'globals.o'}, "has PL_VarsPtr");
    ok($symbols{data}{common}{PL_Vars}{'globals.o'}, "has PL_Vars");

    # -DPERL_GLOBAL_STRUCT has extra text symbol for accessing the vars.
    ok($symbols{text}{Perl_GetVars}{'util.o'}, "has Perl_GetVars");
} else {
    print "# neither -DPERL_GLOBAL_STRUCT nor -DPERL_GLOBAL_STRUCT_PRIVATE\n";

    if ( !$symbols{data}{common} ) {
        # This is likely because Perl was compiled with 
        # -Accflags="-fno-common"
        $symbols{data}{common} = $symbols{data}{bss};
    }
    
    ok($symbols{data}{common}{PL_hash_seed}{'globals.o'}, "has PL_hash_seed");
    ok($symbols{data}{data}{PL_ppaddr}{'globals.o'}, "has PL_ppaddr");

    # None of the GLOBAL_STRUCT* business here.
    ok(! exists $symbols{data}{data}{PL_VarsPtr}, "has no PL_VarsPtr");
    ok(! exists $symbols{data}{common}{PL_Vars}, "has no PL_Vars");
    ok(! exists $symbols{text}{Perl_GetVars}, "has no Perl_GetVars");
}

if (defined $nm_err_tmp) {
    if (open(my $nm_err_fh, $nm_err_tmp)) {
        my $error;
        while (<$nm_err_fh>) {
            # OS X has weird error where nm warns about
            # "no name list" but then outputs fine.
            if (/nm: no name list/ && $^O eq 'darwin') {
                print "# $^O ignoring $nm output: $_";
                next;
            }
            warn "$0: Unexpected $nm error: $_";
            $error++;
        }
        die "$0: Unexpected $nm errors\n" if $error;
    } else {
        warn "Failed to open '$nm_err_tmp': $!\n";
    }
}

done_testing();
Commit	Line	Data
d92f47ae JH	1	#!/usr/bin/perl -w
	2
	3	# Try opening libperl.a with nm, and verifying it has the kind of symbols
	4	# we expected. Fail softly, expect things only on known platforms.
	5	#
	6	# Also, if the rarely-used builds options -DPERL_GLOBAL_STRUCT or
	7	# -DPERL_GLOBAL_STRUCT_PRIVATE are used, verify that they did what
	8	# they were meant to do, hide the global variables (see perlguts for
	9	# the details).
caea674c JH	10	#
	11	# Debugging tip: nm output (this script's input) can be faked by
	12	# giving one command line argument for this script: it should be
	13	# either the filename to read, or "-" for STDIN.
d92f47ae JH	14
	15	BEGIN {
	16	chdir 't' if -d 't';
	17	@INC = '../lib';
	18	require "./test.pl";
	19	}
	20
	21	use strict;
	22
	23	use Config;
	24
	25	if ($Config{cc} =~ /g\+\+/) {
	26	# XXX Could use c++filt, maybe.
	27	skip_all "on g++";
	28	}
	29
	30	my $libperl_a;
	31
	32	for my $f (qw(../libperl.a libperl.a)) {
	33	if (-f $f) {
	34	$libperl_a = $f;
	35	last;
	36	}
	37	}
	38
	39	unless (defined $libperl_a) {
	40	skip_all "no libperl.a";
	41	}
	42
cb498e56 JH	43	print "# \$^O = $^O\n";
cb498e56 JH	44	print "# \$Config{cc} = $Config{cc}\n";
d92f47ae JH	45	print "# libperl = $libperl_a\n";
	46
	47	my $nm;
	48	my $nm_opt = '';
	49	my $nm_style;
	50
	51	if ($^O eq 'linux') {
	52	$nm = '/usr/bin/nm';
	53	$nm_style = 'gnu';
	54	} elsif ($^O eq 'darwin') {
	55	$nm = '/usr/bin/nm';
	56	$nm_style = 'darwin';
	57	# With the -m option we get better information than the BSD-like
	58	# default: with the default, a lot of symbols get dumped into 'S'
	59	# or 's', for example one cannot tell the difference between const
	60	# and non-const symbols.
	61	$nm_opt = '-m';
	62	}
	63
	64	unless (defined $nm) {
	65	skip_all "no nm";
	66	}
	67
	68	unless (defined $nm_style) {
	69	skip_all "no nm style";
	70	}
	71
	72	print "# nm = $nm\n";
	73	print "# nm_style = $nm_style\n";
	74	print "# nm_opt = $nm_opt\n";
	75
	76	unless (-x $nm) {
	77	skip_all "no executable nm $nm";
	78	}
	79
	80	if ($nm_style eq 'gnu') {
	81	open(my $nm_fh, "$nm --version\|") or
	82	skip_all "nm failed: $!";
	83	my $gnu_verified;
	84	while (<$nm_fh>) {
	85	if (/^GNU nm/) {
	86	$gnu_verified = 1;
	87	last;
	88	}
	89	}
	90	unless ($gnu_verified) {
f7bdd0be	91	skip_all "no GNU nm";
d92f47ae JH	92	}
	93	}
	94
b52baaa9 JH	95	my $nm_err_tmp = "libperl$$";
	96
	97	END {
f7bdd0be TC	98	# this is still executed when we skip_all above, avoid a warning
f7bdd0be TC	99	unlink $nm_err_tmp if $nm_err_tmp;
b52baaa9 JH	100	}
b52baaa9 JH	101
caea674c	102	my $nm_fh;
d92f47ae	103
caea674c JH	104	if (@ARGV == 1) {
	105	my $fake = shift @ARGV;
	106	print "# Faking nm output from $fake\n";
	107	if ($fake eq '-') {
	108	open($nm_fh, "<&STDIN") or
	109	skip_all "Duping STDIN failed: $!";
	110	} else {
	111	open($nm_fh, "<", $fake) or
	112	skip_all "Opening '$fake' failed: $!";
	113	}
	114	undef $nm_err_tmp; # In this case there will be no nm errors.
	115	} else {
	116	open($nm_fh, "$nm $nm_opt $libperl_a 2>$nm_err_tmp \|") or
	117	skip_all "$nm $nm_opt $libperl_a failed: $!";
	118	}
	119
d92f47ae JH	120	sub nm_parse_gnu {
d92f47ae JH	121	my $symbols = shift;
7c616f70	122	my $line = $_;
d92f47ae JH	123	if (m{^(\w+\.o):$}) {
	124	$symbols->{obj}{$1}++;
	125	$symbols->{o} = $1;
7c616f70	126	return;
d92f47ae	127	} else {
7c616f70 JH	128	die "$0: undefined current object: $line"
	129	unless defined $symbols->{o};
	130	if (s/^[0-9a-f]{8}(?:[0-9a-f]{8})? //) {
	131	if (/^[Rr] (\w+)$/) {
	132	$symbols->{data}{const}{$1}{$symbols->{o}}++;
	133	} elsif (/^r .+$/) {
	134	# Skip local const.
	135	} elsif (/^[Tti] (\w+)(\..+)?$/) {
	136	$symbols->{text}{$1}{$symbols->{o}}++;
	137	} elsif (/^C (\w+)$/) {
	138	$symbols->{data}{common}{$1}{$symbols->{o}}++;
	139	} elsif (/^[BbSs] (\w+)(\.\d+)?$/) {
	140	$symbols->{data}{bss}{$1}{$symbols->{o}}++;
	141	} elsif (/^0{16} D _LIB_VERSION$/) {
	142	# Skip the _LIB_VERSION (not ours).
	143	} elsif (/^[DdGg] (\w+)$/) {
	144	$symbols->{data}{data}{$1}{$symbols->{o}}++;
	145	} elsif (/^. \.?(\w+)$/) {
	146	# Skip the unknown types.
	147	print "# Unknown type: $line ($symbols->{o})\n";
	148	}
	149	return;
	150	} elsif (/^ {8}(?: {8})? U (\w+)$/) {
	151	# Skip the undefined.
	152	return;
d92f47ae JH	153	}
d92f47ae JH	154	}
7c616f70	155	print "# Unexpected nm output '$line' ($symbols->{o})\n";
d92f47ae JH	156	}
	157
	158	sub nm_parse_darwin {
	159	my $symbols = shift;
7c616f70	160	my $line = $_;
d92f47ae JH	161	if (m{^(?:\.\./)?libperl\.a\((\w+\.o)\):$}) {
	162	$symbols->{obj}{$1}++;
	163	$symbols->{o} = $1;
7c616f70	164	return;
d92f47ae	165	} else {
7c616f70 JH	166	die "$0: undefined current object: $line" unless defined $symbols->{o};
7c616f70 JH	167	if (s/^[0-9a-f]{8}(?:[0-9a-f]{8})? //) {
6d1ca00b	168	if (/^\(__TEXT,__(?:const\|cstring\|literal\d+)\) (?:non-)?external _?(\w+)(\.\w+)?$/) {
7c616f70 JH	169	my ($symbol, $suffix) = ($1, $2);
	170	# Ignore function-local constants like
	171	# _Perl_av_extend_guts.oom_array_extend
	172	return if defined $suffix && /__TEXT,__const/;
6d1ca00b JH	173	# Ignore the cstring unnamed strings.
6d1ca00b JH	174	return if $symbol =~ /^L\.str\d+$/;
7c616f70 JH	175	$symbols->{data}{const}{$symbol}{$symbols->{o}}++;
	176	} elsif (/^\(__TEXT,__text\) (?:non-)?external _(\w+)$/) {
	177	$symbols->{text}{$1}{$symbols->{o}}++;
	178	} elsif (/^\(__DATA,__(const\|data\|bss\|common)\) (?:non-)?external _(\w+)(\.\w+)?$/) {
	179	my ($dtype, $symbol, $suffix) = ($1, $2, $3);
	180	# Ignore function-local constants like
	181	# _Perl_pp_gmtime.dayname
	182	return if defined $suffix;
	183	$symbols->{data}{$dtype}{$symbol}{$symbols->{o}}++;
	184	} elsif (/^\(__DATA,__const\) non-external _\.memset_pattern\d*$/) {
	185	# Skip this, whatever it is (some inlined leakage from
	186	# darwin libc?)
6d1ca00b JH	187	} elsif (/^\(__TEXT,__eh_frame/) {
	188	# Skip the eh_frame symbols.
	189	return;
7c616f70 JH	190	} elsif (/^\(__\w+,__\w+\) /) {
	191	# Skip the unknown types.
	192	print "# Unknown type: $line ($symbols->{o})\n";
	193	}
	194	return;
	195	} elsif (/^ {8}(?: {8})? \(undefined\) /) {
d92f47ae	196	# Skip the undefined.
7c616f70	197	return;
d92f47ae JH	198	}
d92f47ae JH	199	}
7c616f70	200	print "# Unexpected nm output '$line' ($symbols->{o})\n";
d92f47ae JH	201	}
	202
	203	my $nm_parse;
	204
	205	if ($nm_style eq 'gnu') {
	206	$nm_parse = \&nm_parse_gnu;
	207	} elsif ($nm_style eq 'darwin') {
	208	$nm_parse = \&nm_parse_darwin;
	209	}
	210
	211	unless (defined $nm_parse) {
cb498e56	212	skip_all "no nm parser ($nm_style $nm_style, \$^O $^O)";
d92f47ae JH	213	}
	214
	215	my %symbols;
	216
	217	while (<$nm_fh>) {
	218	next if /^$/;
	219	chomp;
	220	$nm_parse->(\%symbols);
	221	}
	222
	223	# use Data::Dumper; print Dumper(\%symbols);
	224
	225	if (keys %symbols == 0) {
	226	skip_all "no symbols\n";
	227	}
	228
	229	# These should always be true for everyone.
	230
	231	ok($symbols{obj}{'pp.o'}, "has object pp.o");
	232	ok($symbols{text}{'Perl_peep'}, "has text Perl_peep");
	233	ok($symbols{text}{'Perl_pp_uc'}{'pp.o'}, "has text Perl_pp_uc in pp.o");
	234	ok(exists $symbols{data}{const}, "has data const symbols");
	235	ok($symbols{data}{const}{PL_no_mem}{'globals.o'}, "has PL_no_mem");
	236
	237	my $DEBUGGING = $Config{ccflags} =~ /-DDEBUGGING/ ? 1 : 0;
	238
	239	my $GS = $Config{ccflags} =~ /-DPERL_GLOBAL_STRUCT\b/ ? 1 : 0;
	240	my $GSP = $Config{ccflags} =~ /-DPERL_GLOBAL_STRUCT_PRIVATE/ ? 1 : 0;
	241
	242	print "# GS = $GS\n";
	243	print "# GSP = $GSP\n";
	244
	245	my %data_symbols;
	246
	247	for my $dtype (sort keys %{$symbols{data}}) {
	248	for my $symbol (sort keys %{$symbols{data}{$dtype}}) {
	249	$data_symbols{$symbol}++;
	250	}
	251	}
	252
d92f47ae JH	253	# The following tests differ between vanilla vs $GSP or $GS.
	254	#
	255	# Some terminology:
	256	# - "text" symbols are code
	257	# - "data" symbols are data (duh), with subdivisions:
	258	# - "bss": (Block-Started-by-Symbol: originally from IBM assembler...),
	259	# uninitialized data, which often even doesn't exist in the object
	260	# file as such, only its size does, which is then created on demand
	261	# by the loader
	262	# - "const": initialized read-only data, like string literals
	263	# - "common": uninitialized data unless initialized...
	264	# (the full story is too long for here, see "man nm")
	265	# - "data": initialized read-write data
	266	# (somewhat confusingly below: "data data", but it makes code simpler)
	267
	268	if ($GSP) {
	269	print "# -DPERL_GLOBAL_STRUCT_PRIVATE\n";
	270	ok(!exists $data_symbols{PL_hash_seed}, "has no PL_hash_seed");
	271	ok(!exists $data_symbols{PL_ppaddr}, "has no PL_ppaddr");
	272
	273	ok(! exists $symbols{data}{bss}, "has no data bss symbols");
26443f8e DM	274	ok(! exists $symbols{data}{data} \|\|
	275	# clang with ASAN seems to add this symbol to every object file:
	276	!grep($_ ne '__unnamed_1', keys %{$symbols{data}{data}}),
	277	"has no data data symbols");
d92f47ae JH	278	ok(! exists $symbols{data}{common}, "has no data common symbols");
	279
	280	# -DPERL_GLOBAL_STRUCT_PRIVATE should NOT have
	281	# the extra text symbol for accessing the vars
	282	# (as opposed to "just" -DPERL_GLOBAL_STRUCT)
	283	ok(! exists $symbols{text}{Perl_GetVars}, "has no Perl_GetVars");
	284	} elsif ($GS) {
	285	print "# -DPERL_GLOBAL_STRUCT\n";
	286	ok(!exists $data_symbols{PL_hash_seed}, "has no PL_hash_seed");
	287	ok(!exists $data_symbols{PL_ppaddr}, "has no PL_ppaddr");
	288
	289	ok(! exists $symbols{data}{bss}, "has no data bss symbols");
	290
	291	# These PerlIO data symbols are left visible with
	292	# -DPERL_GLOBAL_STRUCT (as opposed to -DPERL_GLOBAL_STRUCT_PRIVATE)
	293	my @PerlIO =
	294	qw(
	295	PerlIO_byte
	296	PerlIO_crlf
	297	PerlIO_pending
	298	PerlIO_perlio
	299	PerlIO_raw
	300	PerlIO_remove
	301	PerlIO_stdio
	302	PerlIO_unix
	303	PerlIO_utf8
	304	);
	305
	306	# PL_magic_vtables is const with -DPERL_GLOBAL_STRUCT_PRIVATE but
	307	# otherwise not const -- because of SWIG which wants to modify
	308	# the table. Evil SWIG, eeevil.
	309
	310	# my_cxt_index is used with PERL_IMPLICIT_CONTEXT, which
	311	# -DPERL_GLOBAL_STRUCT has turned on.
99a0b65c JH	312	eq_array([sort keys %{$symbols{data}{data}}],
	313	[sort('PL_VarsPtr',
	314	@PerlIO,
	315	'PL_magic_vtables',
	316	'my_cxt_index')],
	317	"data data symbols");
d92f47ae JH	318
d92f47ae JH	319	# Only one data common symbol, our "supervariable".
99a0b65c JH	320	eq_array([sort keys %{$symbols{data}{common}}],
	321	['PL_Vars'],
	322	"data common symbols");
d92f47ae JH	323
	324	ok($symbols{data}{data}{PL_VarsPtr}{'globals.o'}, "has PL_VarsPtr");
	325	ok($symbols{data}{common}{PL_Vars}{'globals.o'}, "has PL_Vars");
	326
	327	# -DPERL_GLOBAL_STRUCT has extra text symbol for accessing the vars.
	328	ok($symbols{text}{Perl_GetVars}{'util.o'}, "has Perl_GetVars");
	329	} else {
	330	print "# neither -DPERL_GLOBAL_STRUCT nor -DPERL_GLOBAL_STRUCT_PRIVATE\n";
	331
a9abea17 BF	332	if ( !$symbols{data}{common} ) {
	333	# This is likely because Perl was compiled with
	334	# -Accflags="-fno-common"
	335	$symbols{data}{common} = $symbols{data}{bss};
	336	}
	337
d92f47ae JH	338	ok($symbols{data}{common}{PL_hash_seed}{'globals.o'}, "has PL_hash_seed");
	339	ok($symbols{data}{data}{PL_ppaddr}{'globals.o'}, "has PL_ppaddr");
	340
	341	# None of the GLOBAL_STRUCT* business here.
	342	ok(! exists $symbols{data}{data}{PL_VarsPtr}, "has no PL_VarsPtr");
	343	ok(! exists $symbols{data}{common}{PL_Vars}, "has no PL_Vars");
	344	ok(! exists $symbols{text}{Perl_GetVars}, "has no Perl_GetVars");
	345	}
	346
caea674c JH	347	if (defined $nm_err_tmp) {
	348	if (open(my $nm_err_fh, $nm_err_tmp)) {
	349	my $error;
	350	while (<$nm_err_fh>) {
	351	# OS X has weird error where nm warns about
	352	# "no name list" but then outputs fine.
	353	if (/nm: no name list/ && $^O eq 'darwin') {
	354	print "# $^O ignoring $nm output: $_";
	355	next;
	356	}
	357	warn "$0: Unexpected $nm error: $_";
	358	$error++;
b52baaa9	359	}
caea674c JH	360	die "$0: Unexpected $nm errors\n" if $error;
	361	} else {
	362	warn "Failed to open '$nm_err_tmp': $!\n";
b52baaa9	363	}
b52baaa9 JH	364	}
b52baaa9 JH	365
d92f47ae	366	done_testing();