test that perl headers don't introduce external references
authorTony Cook <tony@develop-help.com>
Sat, 13 Apr 2013 04:49:26 +0000 (14:49 +1000)
committerNicholas Clark <nick@ccl4.org>
Fri, 3 May 2013 11:35:16 +0000 (13:35 +0200)
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]

MANIFEST
t/porting/extrefs.t [new file with mode: 0644]

index aa76504..061bfeb 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -5482,6 +5482,7 @@ t/porting/customized.t            Check all CUSTOMIZED files are as they should be
 t/porting/diag.t               Test completeness of perldiag.pod
 t/porting/dual-life.t          Check that dual-life bins are in utils/
 t/porting/exec-bit.t           Check that exec-bit bins are identified
+t/porting/extrefs.t            Check perl headers don't make extern refs
 t/porting/filenames.t          Check the MANIFEST for filename portability.
 t/porting/FindExt.t            Test win32/FindExt.pm
 t/porting/globvar.t            Check that globvar.sym is sane
diff --git a/t/porting/extrefs.t b/t/porting/extrefs.t
new file mode 100644 (file)
index 0000000..50f5847
--- /dev/null
@@ -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;
+}