t/porting/globvar.t

   1 #!perl -w
   2
   3 use TestInit qw(T);
   4 use strict;
   5 use Config;
   6
   7 require 't/test.pl';
   8
   9 skip_all("Code to read symbols not ported to $^O")
  10     if $^O eq 'VMS' or $^O eq 'MSWin32';
  11
  12 # Not investigated *why* we don't export these, but we don't, and we've not
  13 # received any bug reports about it causing problems:
  14 my %skip = map { ("PL_$_", 1) }
  15     qw(
  16           DBcv bitcount cshname force_link_funcs generation lastgotoprobe
  17           mod_latin1_uc modcount no_symref_sv timesbuf uudmap
  18           watchaddr watchok warn_uninit_sv
  19      );
  20
  21 my $trial = "nm globals$Config{_o} 2>&1";
  22 my $yes = `$trial`;
  23
  24 skip_all("Could not run `$trial`") if $?;
  25
  26 my $defined = qr/^[0-9a-fA-F]{8,16}\s+[^Uu]\s+_?/m;
  27
  28 skip_all("Could not spot definition of PL_Yes in output of `$trial`")
  29     unless $yes =~ /${defined}PL_Yes/m;
  30
  31 my %exported;
  32 open my $fh, '-|', $^X, '-Ilib', './makedef.pl', 'PLATFORM=test'
  33     or die "Can't run makedef.pl";
  34
  35 while (<$fh>) {
  36     next unless /^PL_/;
  37     chomp;
  38     ++$exported{$_};
  39 }
  40
  41 close $fh or die "Problem running makedef.pl";
  42
  43 my %unexported;
  44
  45 foreach my $file (map {$_ . $Config{_o}} qw(globals regcomp)) {
  46     open $fh, '-|', 'nm', $file
  47         or die "Can't run nm $file";
  48
  49     while (<$fh>) {
  50         next unless /$defined(PL_\S+)/;
  51         if (delete $exported{$1}) {
  52             note("Seen definition of $1");
  53             next;
  54         }
  55         ++$unexported{$1};
  56     }
  57     close $fh or die "Problem running nm $file";
  58 }
  59
  60 fail("Attempting to export '$_' which is never defined")
  61     foreach sort keys %exported;
  62
  63 foreach (sort keys %unexported) {
  64  SKIP: {
  65         skip("We don't export $_", 1) if $skip{$_};
  66         fail("$_ is defined, but we do not export it");
  67     }
  68 }
  69
  70 done_testing();