diff options
author | Tony Cook <tony@develop-help.com> | 2013-04-13 14:49:26 +1000 |
---|---|---|
committer | Nicholas Clark <nick@ccl4.org> | 2013-05-03 13:35:16 +0200 |
commit | 68fd3ca593e2702683881553a01eb879030f8914 (patch) | |
tree | 82e1c12ce979776544831c6e42a2a3842e3537d5 /t/porting | |
parent | c7627e6d4346964cad693419f41c942591ebaf35 (diff) | |
download | perl-68fd3ca593e2702683881553a01eb879030f8914.tar.gz |
test that perl headers don't introduce external references
This is as close as possible to the original Time::HiRes probe code,
further commits will clean that up.
[perl #116989]
[Amended from Tony's original to add -DPERL_NO_INLINE_FUNCTIONS]
Diffstat (limited to 't/porting')
-rw-r--r-- | t/porting/extrefs.t | 155 |
1 files changed, 155 insertions, 0 deletions
diff --git a/t/porting/extrefs.t b/t/porting/extrefs.t new file mode 100644 index 0000000000..50f584713c --- /dev/null +++ b/t/porting/extrefs.t @@ -0,0 +1,155 @@ +#!./perl -w + +# What does this test? +# Test that changes to perl header files don't cause external +# references by simplying #including them. This breaks library probe +# code on CPAN, and can break cflags.SH. +# +# Why do we test this? +# See https://rt.perl.org/rt3/Ticket/Display.html?id=116989 +# +# It's broken - how do I fix it? +# You added an initializer or static function to a header file that +# references some symbol you didn't define, you need to remove it. + +use strict; +use warnings; + +BEGIN { + require "./test.pl"; + unshift @INC, ".." if -f "../TestInit.pm"; +} + +use TestInit qw(T A); # T is chdir to the top level, A makes paths absolute +use Config; +use File::Path 'rmtree'; +use Cwd; + +skip_all("we don't test this on Win32") if $^O eq "MSWin32"; + +plan(tests => 1); + +ok(try_compile_and_link(<<'CODE')); +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +int main(int argc, char **argv) { + return 0; +} +CODE + + +# from Time::HiRes's Makefile.PL with minor modifications +sub try_compile_and_link { + my ($c, %args) = @_; + + my $LIBS = []; + my $ld_exeext = ($^O eq 'cygwin' || + $^O eq 'os2' && $Config{ldflags} =~ /-Zexe\b/) ? '.exe' : + (($^O eq 'vos') ? $Config{exe_ext} : ''); + my $VERBOSE = 1; + + my ($ok) = 0; + my $tempdir = tempfile(); + my $cwd = getcwd(); + mkdir $tempdir; + chdir $tempdir; + my ($tmp) = "temp"; + local(*TMPC); + + my $obj_ext = $Config{obj_ext} || ".o"; + unlink("$tmp.c", "$tmp$obj_ext"); + + if (open(TMPC, ">$tmp.c")) { + print TMPC $c; + close(TMPC); + + my $cccmd = $args{cccmd}; + + my $errornull; + + my $COREincdir; + + if ($ENV{PERL_CORE}) { + my $updir = File::Spec->updir; + $COREincdir = File::Spec->catdir($updir); + } else { + $COREincdir = File::Spec->catdir($Config{'archlibexp'}, 'CORE'); + } + + if ($ENV{PERL_CORE}) { + unless (-f File::Spec->catfile($COREincdir, "EXTERN.h")) { + chdir($cwd); + rmtree($tempdir); + die <<__EOD__; +Your environment variable PERL_CORE is '$ENV{PERL_CORE}' but there +is no EXTERN.h in $COREincdir. +Cannot continue, aborting. +__EOD__ + } + } + + my $ccflags = $Config{'ccflags'} . ' ' . "-I$COREincdir" + . ' -DPERL_NO_INLINE_FUNCTIONS'; + + if ($^O eq 'VMS') { + $cccmd = "$Config{'cc'} /include=($COREincdir) $tmp.c"; + } + + if ($args{silent} || !$VERBOSE) { + $errornull = "2>/dev/null" unless defined $errornull; + } else { + $errornull = ''; + } + + $cccmd = "$Config{'cc'} -o $tmp $ccflags $tmp.c @$LIBS $errornull" + unless defined $cccmd; + + if ($^O eq 'VMS') { + open( CMDFILE, ">$tmp.com" ); + print CMDFILE "\$ SET MESSAGE/NOFACILITY/NOSEVERITY/NOIDENT/NOTEXT\n"; + print CMDFILE "\$ $cccmd\n"; + print CMDFILE "\$ IF \$SEVERITY .NE. 1 THEN EXIT 44\n"; # escalate + close CMDFILE; + system("\@ $tmp.com"); + $ok = $?==0; + chdir($cwd); + rmtree($tempdir); + #for ("$tmp.c", "$tmp$obj_ext", "$tmp.com", "$tmp$Config{exe_ext}") { + #1 while unlink $_; + #} + } + else + { + my $tmp_exe = "$tmp$ld_exeext"; + printf "cccmd = $cccmd\n" if $VERBOSE; + my $res = system($cccmd); + $ok = defined($res) && $res == 0 && -s $tmp_exe && -x _; + + if ( $ok && exists $args{run} && $args{run}) { + my $tmp_exe = + File::Spec->catfile(File::Spec->curdir, $tmp_exe); + printf "Running $tmp_exe..." if $VERBOSE; + if (system($tmp_exe) == 0) { + $ok = 1; + } else { + $ok = 0; + my $errno = $? >> 8; + local $! = $errno; + printf <<EOF; + +*** The test run of '$tmp_exe' failed: status $? +*** (the status means: errno = $errno or '$!') +*** DO NOT PANIC: this just means that *some* functionality will be missing. +EOF + } + } + chdir($cwd); + rmtree($tempdir); + #unlink("$tmp.c", $tmp_exe); + } + } + + return $ok; +} |