Add tests for mX?PUSH[inup] macros.

Subject: Re: [PATCH] Document limitations in PUSHi et al macros and add new mPUSHi et al macros
Message-ID: <4098FB85.1060602@uk.radan.com>

p4raw-id: //depot/perl@22783

4 files changed, 105 insertions, 0 deletions

diff --git a/ext/XS/APItest/APItest.pm b/ext/XS/APItest/APItest.pm
index 322fdc6d10..b80b86f120 100644
--- a/ext/XS/APItest/APItest.pm
+++ b/ext/XS/APItest/APItest.pm
@@ -14,6 +14,8 @@ use base qw/ DynaLoader Exporter /;
 # Export everything since these functions are only used by a test script
 our @EXPORT = qw( print_double print_int print_long
 		  print_float print_long_double have_long_double print_flush
+		  mpushp mpushn mpushi mpushu
+		  mxpushp mxpushn mxpushi mxpushu
 );
 
 our $VERSION = '0.03';
diff --git a/ext/XS/APItest/APItest.xs b/ext/XS/APItest/APItest.xs
index 02a169423c..df43b8947d 100644
--- a/ext/XS/APItest/APItest.xs
+++ b/ext/XS/APItest/APItest.xs
@@ -175,3 +175,71 @@ void
 print_flush()
     	CODE:
 	fflush(stdout);
+
+void
+mpushp()
+	PPCODE:
+	EXTEND(SP, 3);
+	mPUSHp("one", 3);
+	mPUSHp("two", 3);
+	mPUSHp("three", 5);
+	XSRETURN(3);
+
+void
+mpushn()
+	PPCODE:
+	EXTEND(SP, 3);
+	mPUSHn(0.5);
+	mPUSHn(-0.25);
+	mPUSHn(0.125);
+	XSRETURN(3);
+
+void
+mpushi()
+	PPCODE:
+	EXTEND(SP, 3);
+	mPUSHn(-1);
+	mPUSHn(2);
+	mPUSHn(-3);
+	XSRETURN(3);
+
+void
+mpushu()
+	PPCODE:
+	EXTEND(SP, 3);
+	mPUSHn(1);
+	mPUSHn(2);
+	mPUSHn(3);
+	XSRETURN(3);
+
+void
+mxpushp()
+	PPCODE:
+	mXPUSHp("one", 3);
+	mXPUSHp("two", 3);
+	mXPUSHp("three", 5);
+	XSRETURN(3);
+
+void
+mxpushn()
+	PPCODE:
+	mXPUSHn(0.5);
+	mXPUSHn(-0.25);
+	mXPUSHn(0.125);
+	XSRETURN(3);
+
+void
+mxpushi()
+	PPCODE:
+	mXPUSHn(-1);
+	mXPUSHn(2);
+	mXPUSHn(-3);
+	XSRETURN(3);
+
+void
+mxpushu()
+	PPCODE:
+	mXPUSHn(1);
+	mXPUSHn(2);
+	mXPUSHn(3);
+	XSRETURN(3);
diff --git a/ext/XS/APItest/MANIFEST b/ext/XS/APItest/MANIFEST
index 5718148b25..f0c29f8485 100644
--- a/ext/XS/APItest/MANIFEST
+++ b/ext/XS/APItest/MANIFEST
@@ -5,3 +5,4 @@ APItest.pm
 APItest.xs
 t/hash.t
 t/printf.t
+t/push.t
diff --git a/ext/XS/APItest/t/push.t b/ext/XS/APItest/t/push.t
new file mode 100644
index 0000000000..66d442e385
--- /dev/null
+++ b/ext/XS/APItest/t/push.t
@@ -0,0 +1,34 @@
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    push @INC, "::lib:$MacPerl::Architecture:" if $^O eq 'MacOS';
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bXS\/APItest\b/) {
+        print "1..0 # Skip: XS::APItest was not built\n";
+        exit 0;
+    }
+}
+
+use Test::More tests => 9;
+
+BEGIN { use_ok('XS::APItest') };
+
+#########################
+
+my @mpushp = mpushp();
+my @mpushn = mpushn();
+my @mpushi = mpushi();
+my @mpushu = mpushu();
+ok(eq_array(\@mpushp, [qw(one two three)]), 'mPUSHp()');
+ok(eq_array(\@mpushn, [0.5, -0.25, 0.125]), 'mPUSHn()');
+ok(eq_array(\@mpushi, [-1, 2, -3]),         'mPUSHi()');
+ok(eq_array(\@mpushu, [1, 2, 3]),           'mPUSHu()');
+
+my @mxpushp = mxpushp();
+my @mxpushn = mxpushn();
+my @mxpushi = mxpushi();
+my @mxpushu = mxpushu();
+ok(eq_array(\@mxpushp, [qw(one two three)]), 'mXPUSHp()');
+ok(eq_array(\@mxpushn, [0.5, -0.25, 0.125]), 'mXPUSHn()');
+ok(eq_array(\@mxpushi, [-1, 2, -3]),         'mXPUSHi()');
+ok(eq_array(\@mxpushu, [1, 2, 3]),           'mXPUSHu()');