XS::Typemap: Tests for T_IN/T_OUT typemapssmueller/typemapdocs4

3 files changed, 64 insertions, 10 deletions

diff --git a/ext/XS-Typemap/Typemap.pm b/ext/XS-Typemap/Typemap.pm
index ec08e86488..7132f725eb 100644
--- a/ext/XS-Typemap/Typemap.pm
+++ b/ext/XS-Typemap/Typemap.pm
@@ -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();
diff --git a/ext/XS-Typemap/Typemap.xs b/ext/XS-Typemap/Typemap.xs
index 11b32b0548..99b3dbef24 100644
--- a/ext/XS-Typemap/Typemap.xs
+++ b/ext/XS-Typemap/Typemap.xs
@@ -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
+
diff --git a/ext/XS-Typemap/t/Typemap.t b/ext/XS-Typemap/t/Typemap.t
index e63ae62def..2baa1cbbec 100644
--- a/ext/XS-Typemap/t/Typemap.t
+++ b/ext/XS-Typemap/t/Typemap.t
@@ -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});
 }