XS::Typemap: Tests for T_IN/T_OUT typemaps
authorSteffen Mueller <smueller@cpan.org>
Thu, 26 Jan 2012 22:54:38 +0000 (23:54 +0100)
committerSteffen Mueller <smueller@cpan.org>
Wed, 1 Feb 2012 07:07:49 +0000 (08:07 +0100)
ext/XS-Typemap/Typemap.pm
ext/XS-Typemap/Typemap.xs
ext/XS-Typemap/t/Typemap.t

index ec08e86..7132f72 100644 (file)
@@ -77,7 +77,7 @@ $VERSION = '0.08';
           T_STDIO_open T_STDIO_close T_STDIO_print
            T_PACKED_in T_PACKED_out
            T_PACKEDARRAY_in T_PACKEDARRAY_out
-           T_INOUT
+           T_INOUT T_IN T_OUT
           /);
 
 XSLoader::load();
index 11b32b0..99b3dbe 100644 (file)
@@ -30,6 +30,8 @@ typedef int intTLONG; /* T_LONG */
 typedef short shortOPQ;   /* T_OPAQUE */
 typedef int intOpq;   /* T_OPAQUEPTR */
 typedef unsigned intUnsigned; /* T_U_INT */
+typedef PerlIO inputfh; /* T_IN */
+typedef PerlIO outputfh; /* T_OUT */
 
 /* A structure to test T_OPAQUEPTR and T_PACKED */
 struct t_opaqueptr {
@@ -232,6 +234,8 @@ AV_FIXED *   T_AVREF_REFCOUNT_FIXED
 HV_FIXED *      T_HVREF_REFCOUNT_FIXED
 CV_FIXED *      T_CVREF_REFCOUNT_FIXED
 SVREF_FIXED     T_SVREF_REFCOUNT_FIXED
+inputfh          T_IN
+outputfh         T_OUT
 
 END_OF_TYPEMAP
 
@@ -1402,19 +1406,19 @@ T_STDIO_print( stream, string )
   RETVAL
 
 
-=item T_IN
-
-NOT YET
-
 =item T_INOUT
 
 This is used for passing perl filehandles to and from C using
 C<PerlIO *> structures. The file handle can used for reading and
-writing.
+writing. This corresponds to the C<+E<lt>> mode, see also T_IN
+and T_OUT.
 
 See L<perliol> for more information on the Perl IO abstraction
 layer. Perl must have been built with C<-Duseperlio>.
 
+There is no check to assert that the filehandle passed from Perl
+to C was created with the right C<open()> mode.
+
 =cut
 
 PerlIO *
@@ -1424,11 +1428,33 @@ T_INOUT(in)
   RETVAL = in; /* silly test but better than nothing */
  OUTPUT: RETVAL
 
+=item T_IN
+
+Same as T_INOUT, but the filehandle that is returned from C to Perl
+can only be used for reading (mode C<E<lt>>). 
+
+=cut
+
+inputfh
+T_IN(in)
+  inputfh in;
+ CODE:
+  RETVAL = in; /* silly test but better than nothing */
+ OUTPUT: RETVAL
+
 =item T_OUT
 
-NOT YET
+Same as T_INOUT, but the filehandle that is returned from C to Perl
+is set to use the open mode C<+E<gt>>.
 
 =back
 
 =cut
 
+outputfh
+T_OUT(in)
+  outputfh in;
+ CODE:
+  RETVAL = in; /* silly test but better than nothing */
+ OUTPUT: RETVAL
+
index e63ae62..2baa1cb 100644 (file)
@@ -6,7 +6,7 @@ BEGIN {
     }
 }
 
-use Test::More tests => 109;
+use Test::More tests => 114;
 
 use strict;
 use warnings;
@@ -356,13 +356,41 @@ if (defined $fh) {
 }
 
 # T_INOUT
+note("T_INOUT");
 SCOPE: {
   my $buf = '';
   local $| = 1;
-  open my $fh, "+>", \$buf or die $!;
+  open my $fh, "+<", \$buf or die $!;
   my $str = "Fooo!\n";
   print $fh $str;
   my $fh2 = T_INOUT($fh);
   seek($fh2, 0, 0);
-  ok(readline($fh2), $str, 'T_INOUT');
+  is(readline($fh2), $str);
+  ok(print $fh2 "foo\n");
+}
+
+# T_IN
+note("T_IN");
+SCOPE: {
+  my $buf = "Hello!\n";
+  local $| = 1;
+  open my $fh, "<", \$buf or die $!;
+  my $fh2 = T_IN($fh);
+  is(readline($fh2), $buf);
+  local $SIG{__WARN__} = sub {die};
+  ok(not(eval {print $fh2 "foo\n"; 1}));
+}
+
+# T_OUT
+note("T_OUT");
+SCOPE: {
+  my $buf = '';
+  local $| = 1;
+  open my $fh, "+<", \$buf or die $!;
+  my $str = "Fooo!\n";
+  print $fh $str;
+  my $fh2 = T_OUT($fh);
+  seek($fh2, 0, 0);
+  is(readline($fh2), $str);
+  ok(eval {print $fh2 "foo\n"; 1});
 }