From: Uri Guttman <uri@quad.(none)>
Date: Wed, 21 Apr 2010 06:49:23 +0000 (-0400)
Subject: new binmode test added
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=6290dc093621d0bab663d04cf17c13349401a76f;p=urisagit%2FPerl-Docs.git

new binmode test added
---

diff --git a/t/binmode.t b/t/binmode.t
new file mode 100644
index 0000000..5549130
--- /dev/null
+++ b/t/binmode.t
@@ -0,0 +1,45 @@
+#!/usr/local/bin/perl -w
+
+use strict ;
+use Test::More ;
+use Carp ;
+use File::Slurp ;
+
+if ( $] < 5.008001 ) {
+        plan skip_all => 'Older Perl lacking unicode support' ;
+	exit ;
+}
+
+plan tests => 2 ;
+
+my $mode = ':utf8' ;
+
+my $orig_text = "\x{20ac}\n" ;
+my $unicode_length = length $orig_text ;
+
+my $control_file = "control.$mode" ;
+my $slurp_file = "slurp.$mode" ;
+
+open( my $fh, ">$mode", $control_file ) or
+	die "cannot create control unicode file '$control_file' $!" ;
+print $fh $orig_text ;
+close $fh ;
+
+my $slurp_utf = read_file( $control_file, binmode => $mode ) ;
+ok( $slurp_utf eq $orig_text, "read_file of $mode file" ) ;
+
+# my $slurp_utf_length = length $slurp_utf ;
+# my $slurp_text = read_file( $control_file ) ;
+# my $slurp_text_length = length $slurp_text ;
+# print "LEN UTF $slurp_utf_length TXT $slurp_text_length\n" ;
+
+write_file( $slurp_file, {binmode => $mode}, $orig_text ) ;
+
+open( $fh, "<$mode", $slurp_file ) or
+	die "cannot open slurp test file '$slurp_file' $!" ;
+my $read_length = read( $fh, my $utf_text, $unicode_length ) ;
+close $fh ;
+
+ok( $utf_text eq $orig_text, "write_file of $mode file" ) ;
+
+unlink( $control_file, $slurp_file ) ;