This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Add tests for mX?PUSH[inup] macros.
authorSteve Hay <SteveHay@planit.com>
Wed, 5 May 2004 15:34:45 +0000 (16:34 +0100)
committerMarcus Holland-Moritz <mhx-perl@gmx.net>
Wed, 5 May 2004 19:02:28 +0000 (19:02 +0000)
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

MANIFEST
ext/XS/APItest/APItest.pm
ext/XS/APItest/APItest.xs
ext/XS/APItest/MANIFEST
ext/XS/APItest/t/push.t [new file with mode: 0644]

index 32262db..293b093 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -791,6 +791,7 @@ ext/XS/APItest/MANIFEST             XS::APItest extension
 ext/XS/APItest/README          XS::APItest extension
 ext/XS/APItest/t/hash.t                XS::APItest extension
 ext/XS/APItest/t/printf.t      XS::APItest extension
 ext/XS/APItest/README          XS::APItest extension
 ext/XS/APItest/t/hash.t                XS::APItest extension
 ext/XS/APItest/t/printf.t      XS::APItest extension
+ext/XS/APItest/t/push.t                XS::APItest extension
 ext/XS/Typemap/Makefile.PL     XS::Typemap extension
 ext/XS/Typemap/README          XS::Typemap extension
 ext/XS/Typemap/stdio.c         XS::Typemap extension
 ext/XS/Typemap/Makefile.PL     XS::Typemap extension
 ext/XS/Typemap/README          XS::Typemap extension
 ext/XS/Typemap/stdio.c         XS::Typemap extension
index 322fdc6..b80b86f 100644 (file)
@@ -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
 # 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';
 );
 
 our $VERSION = '0.03';
index 02a1694..df43b89 100644 (file)
@@ -175,3 +175,71 @@ void
 print_flush()
        CODE:
        fflush(stdout);
 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);
index 5718148..f0c29f8 100644 (file)
@@ -5,3 +5,4 @@ APItest.pm
 APItest.xs
 t/hash.t
 t/printf.t
 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 (file)
index 0000000..66d442e
--- /dev/null
@@ -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()');