[libyaml-libyaml-perl] 01/11: Added DumpFile and LoadFile tests for IO::Pipe and IO::File objects

[gregor herrmann]

This is an automated email from the git hooks/post-receive script.

gregoa pushed a commit to branch gregoa/use-system-yaml
in repository libyaml-libyaml-perl.

commit ef068b466de911d397545a64b34edd2a830aaffd
Author: Alan Mizrahi <alan+crux at mizrahi.com.ve>
Date:   Wed Feb 10 10:49:23 2016 +0900

    Added DumpFile and LoadFile tests for IO::Pipe and IO::File objects
---
 lib/YAML/XS.pm |  4 ++--
 t/io-handle.t  | 57 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 59 insertions(+), 2 deletions(-)

diff --git a/lib/YAML/XS.pm b/lib/YAML/XS.pm
index 29e592b..040cdd5 100644
--- a/lib/YAML/XS.pm
+++ b/lib/YAML/XS.pm
@@ -21,7 +21,7 @@ use YAML::XS::LibYAML qw(Load Dump);
 sub DumpFile {
     my $OUT;
     my $filename = shift;
-    if (ref $filename eq 'GLOB') {
+    if (defined fileno($filename)) {
         $OUT = $filename;
     }
     else {
@@ -39,7 +39,7 @@ sub DumpFile {
 sub LoadFile {
     my $IN;
     my $filename = shift;
-    if (ref $filename eq 'GLOB') {
+    if (defined fileno($filename)) {
         $IN = $filename;
     }
     else {
diff --git a/t/io-handle.t b/t/io-handle.t
new file mode 100644
index 0000000..8b385df
--- /dev/null
+++ b/t/io-handle.t
@@ -0,0 +1,57 @@
+use strict;
+use lib -e 't' ? 't' : 'test';
+my $t = -e 't' ? 't' : 'test';
+
+use utf8;
+use lib 'inc';
+BEGIN {
+    @Test::YAML::EXPORT =
+        grep { not /^(Dump|Load)(File)?$/ } @Test::YAML::EXPORT;
+}
+use IO::Pipe;
+use IO::File;
+use t::TestYAML tests => 6;
+use YAML qw/DumpFile LoadFile/;;
+
+my $testdata = 'El país es medible. La patria es del tamaño del corazón de quien la quiere.';
+
+
+# IO::Pipe
+
+my $pipe = new IO::Pipe;
+
+if ( fork() ) { # parent reads from IO::Pipe handle
+	$pipe->reader();
+	my $recv_data = LoadFile($pipe);
+	is length($recv_data), length($testdata), 'LoadFile from IO::Pipe read data';
+	is $recv_data, $testdata, 'LoadFile from IO::Pipe contents is correct';
+} else { # child writes to IO::Pipe handle
+	$pipe->writer();
+	DumpFile($pipe, $testdata);
+	exit 0;
+}
+
+# IO::File
+
+my $file = "$t/dump-io-file-$$.yaml";
+my $fh = new IO::File;
+
+# write to IO::File handle
+$fh->open($file, '>:utf8') or die $!;
+DumpFile($fh, $testdata);
+$fh->close;
+ok -e $file, 'IO::File output file exists';
+
+# read from IO::File handle
+$fh->open($file, '<:utf8') or die $!;
+my $yaml = do { local $/; <$fh> };
+is $yaml, "--- $testdata\n", 'LoadFile from IO::File contents is correct';
+
+$fh->seek(0, 0);
+my $read_data = LoadFile($fh) or die $!;
+$fh->close;
+
+is length($read_data), length($testdata), 'LoadFile from IO::File read data';
+is $read_data, $testdata, 'LoadFile from IO::File read data';
+
+unlink $file;

-- 
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libyaml-libyaml-perl.git