XS::APItest tests for XS_VERSION_BOOTCHECK.

5 files changed, 126 insertions, 1 deletions

diff --git a/MANIFEST b/MANIFEST
index d779482796..314968e07e 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -3404,7 +3404,9 @@ ext/XS-APItest/t/temp_lv_sub.t	XS::APItest: tests for lvalue subs returning temp
 ext/XS-APItest/t/utf16_to_utf8.t	Test behaviour of utf16_to_utf8{,reversed}
 ext/XS-APItest/t/xs_special_subs_require.t	for require too
 ext/XS-APItest/t/xs_special_subs.t	Test that XS BEGIN/CHECK/INIT/END work
+ext/XS-APItest/t/xsub_h.t	Tests for XSUB.h
 ext/XS-APItest/typemap
+ext/XS-APItest/XSUB-undef-XS_VERSION.xs	XS code needing #undef XS_VERSION
 ext/XS-Typemap/Makefile.PL	XS::Typemap extension
 ext/XS-Typemap/README		XS::Typemap extension
 ext/XS-Typemap/stdio.c		XS::Typemap extension
diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs
index 4b3d470328..332292292c 100644
--- a/ext/XS-APItest/APItest.xs
+++ b/ext/XS-APItest/APItest.xs
@@ -605,6 +605,8 @@ static int my_keyword_plugin(pTHX_
     }
 }
 
+XS(XS_XS__APItest__XSUB_XS_VERSION_undef);
+
 #include "const-c.inc"
 
 MODULE = XS::APItest		PACKAGE = XS::APItest
@@ -613,6 +615,17 @@ INCLUDE: const-xs.inc
 
 INCLUDE: numeric.xs
 
+MODULE = XS::APItest		PACKAGE = XS::APItest::XSUB
+
+BOOT:
+    newXS("XS::APItest::XSUB::XS_VERSION_undef", XS_XS__APItest__XSUB_XS_VERSION_undef, __FILE__);
+
+void
+XS_VERSION_defined(...)
+    PPCODE:
+        XS_VERSION_BOOTCHECK;
+        XSRETURN_EMPTY;
+
 MODULE = XS::APItest:Hash		PACKAGE = XS::APItest::Hash
 
 void
diff --git a/ext/XS-APItest/Makefile.PL b/ext/XS-APItest/Makefile.PL
index 3af0eb4f96..084de96034 100644
--- a/ext/XS-APItest/Makefile.PL
+++ b/ext/XS-APItest/Makefile.PL
@@ -10,7 +10,7 @@ WriteMakefile(
     ABSTRACT_FROM	=> 'APItest.pm', # retrieve abstract from module
     AUTHOR		=> 'Tim Jenness <t.jenness@jach.hawaii.edu>, Christian Soeller <csoelle@mph.auckland.ac.nz>, Hugo van der Sanden <hv@crypt.compulink.co.uk>, Andrew Main (Zefram) <zefram@fysh.org>',
     'C'                 => ['exception.c', 'core.c', 'notcore.c'],
-    'OBJECT'            => '$(BASEEXT)$(OBJ_EXT) $(O_FILES)',
+    'OBJECT'            => '$(BASEEXT)$(OBJ_EXT) XSUB-undef-XS_VERSION$(OBJ_EXT) $(O_FILES)',
     realclean => {FILES	=> 'const-c.inc const-xs.inc'},
     ($Config{gccversion} && $Config{d_attribute_deprecated} ?
       (CCFLAGS => $Config{ccflags} . ' -Wno-deprecated-declarations') : ()),
diff --git a/ext/XS-APItest/XSUB-undef-XS_VERSION.xs b/ext/XS-APItest/XSUB-undef-XS_VERSION.xs
new file mode 100644
index 0000000000..9fdf4d4436
--- /dev/null
+++ b/ext/XS-APItest/XSUB-undef-XS_VERSION.xs
@@ -0,0 +1,18 @@
+#include "EXTERN.h"
+#include "perl.h"
+
+/* We have to be in a different .xs so that we can do this:  */
+
+#undef XS_VERSION
+#include "XSUB.h"
+
+/* This can't be "MODULE = XS::APItest" as then we get duplicate bootstraps.  */
+MODULE = XS::APItest::XSUB	PACKAGE = XS::APItest::XSUB
+
+PROTOTYPES: DISABLE
+
+void
+XS_VERSION_undef(...)
+    PPCODE:
+        XS_VERSION_BOOTCHECK;
+        XSRETURN_EMPTY;
diff --git a/ext/XS-APItest/t/xsub_h.t b/ext/XS-APItest/t/xsub_h.t
new file mode 100644
index 0000000000..c25b3a9a8c
--- /dev/null
+++ b/ext/XS-APItest/t/xsub_h.t
@@ -0,0 +1,92 @@
+#!perl -w
+use strict;
+
+use Test::More;
+
+BEGIN { use_ok('XS::APItest') };
+
+use vars qw($XS_VERSION $VERSION);
+
+# This is what the code expects
+my $real_version = $XS::APItest::VERSION;
+
+sub default {
+    return ($_[0], undef) if @_;
+    return ($XS_VERSION, 'XS_VERSION') if defined $XS_VERSION;
+    return ($VERSION, 'VERSION');
+}
+
+sub expect_good {
+    my $package = $_[0];
+    my $version = exists $_[1] ? ", $_[1]" : '';
+    local $Test::Builder::Level = $Test::Builder::Level + 1;
+    is_deeply([XS_VERSION_defined(@_)], [],
+	      "Is good for $package$version");
+
+    is_deeply([XS_VERSION_undef(@_)], [],
+	      "Is good for $package$version with #undef XS_VERSION");
+}
+
+sub expect_bad {
+    my $what = shift;
+    my $package = $_[0];
+    my $desc; # String to use in test descriptions
+
+    if (defined $what) {
+	$what = quotemeta('$' . $package . '::' . $what);
+    } else {
+	$what = 'bootstrap parameter';
+    }
+    if (exists $_[1]) {
+	$desc = "$_[0], $_[1]";
+    } else {
+	$desc = $_[0];
+    }
+
+    is(eval {XS_VERSION_defined(@_); "Oops"}, undef, "Is bad for $desc");
+    like($@,
+	 qr/$package object version $real_version does not match $what/,
+	 'expected error message');
+
+    is_deeply([XS_VERSION_undef(@_)], [],
+	      "but is good for $desc with #undef XS_VERSION");
+}
+
+# With neither $VERSION nor $XS_VERSION defined, no check is made if no version
+# is passed in
+expect_good('dummy_package');
+
+foreach ($real_version, version->new($real_version)) {
+    expect_good('dummy_package', $_);
+}
+
+foreach (3.14, version->new(3.14)) {
+    expect_bad(undef, 'dummy_package', $_);
+}
+
+my @versions = ($real_version, version->new($real_version),
+		3.14, version->new(3.14));
+
+# Package variables
+foreach $XS_VERSION (undef, @versions) {
+    foreach $VERSION (undef, @versions) {
+	my ($expect, $what) = default();
+	if (defined $expect) {
+	    if ($expect eq $real_version) {
+		expect_good('main');
+	    } else {
+		expect_bad($what, 'main');
+	    }
+	}
+	foreach my $param (@versions) {
+	    my ($expect, $what) = default($param);
+	    if ($expect eq $real_version) {
+		expect_good('main', $param);
+	    } else {
+		expect_bad($what, 'main', $param);
+	    }
+	}
+    }
+}
+
+done_testing();