# !perl #$Id: 07_select.t 1215 2008-02-09 23:46:05Z jimk $ # 07_select.t - test say() when select is called after filehandle is opened use strict; use warnings; use Test::More tests => 19; use lib ( qq{./t/lib} ); BEGIN { use_ok('Perl6::Say'); use_ok('Carp'); use_ok('Perl6::Say::Auxiliary', qw| _validate capture_say_scalar |); }; my %diagnostics = ( open => qq{Cannot open filehandle to scalar ref for writing}, close => qq{Cannot close filehandle to scalar ref after writing}, ); my ($say_sub, $msg, @list); SKIP: { my $skipped_tests = (19 - 3); eval { require 5.008 }; my $reason = q{Writing to in-memory files (>\$string) not supported prior to Perl 5.8}; skip $reason, $skipped_tests if $@; ##### Global Filehandle: Direct ##### $say_sub = sub { my $arg = shift; my $string = q{}; open FH, ">", \$string or croak $diagnostics{open}; select(FH); ref($arg eq q{ARRAY}) ? say @{$arg} : say $arg; close FH or croak $diagnostics{close}; return $string; }; $msg= q{correctly printed to string via global filehandle, selected}; @list = ( 'Hello', ' ', 'World' ); capture_say_scalar( { data => \@list, pred => 1, eval => $say_sub, msg => $msg, } ); @list = ( 'Hello', ' ', 'World', "\n" ); capture_say_scalar( { data => \@list, pred => 2, eval => $say_sub, msg => $msg, } ); @list = ( 'Hello', ' ', 'World', "\n", 'Again!', "\n" ); capture_say_scalar( { data => \@list, pred => 3, eval => $say_sub, msg => $msg, } ); @list = ( ); capture_say_scalar( { data => \@list, pred => 1, eval => $say_sub, msg => $msg, } ); ##### Global Filehandle: Arrow ##### $say_sub = sub { my $arg = shift; my $string = q{}; open FH, ">", \$string or croak $diagnostics{open}; select(FH); ref($arg eq q{ARRAY}) ? say @{$arg} : say $arg; close FH or croak $diagnostics{close}; return $string; }; $msg= q{correctly printed to string via global filehandle, selected, arrow syntax}; @list = ( 'Hello', ' ', 'World' ); capture_say_scalar( { data => \@list, pred => 1, eval => $say_sub, msg => $msg, } ); @list = ( 'Hello', ' ', 'World', "\n" ); capture_say_scalar( { data => \@list, pred => 2, eval => $say_sub, msg => $msg, } ); @list = ( 'Hello', ' ', 'World', "\n", 'Again!', "\n" ); capture_say_scalar( { data => \@list, pred => 3, eval => $say_sub, msg => $msg, } ); @list = ( ); capture_say_scalar( { data => \@list, pred => 1, eval => $say_sub, msg => $msg, } ); ##### Lexical Filehandle: Comma ##### $say_sub = sub { my $arg = shift; my $string = q{}; open my $fh, ">", \$string or croak $diagnostics{open}; select($fh); ref($arg eq q{ARRAY}) ? say @{$arg} : say $arg; close $fh or croak $diagnostics{close}; return $string; }; $msg= q{correctly printed to string via lexical filehandle, selected, comma syntax}; @list = ( 'Hello', ' ', 'World' ); capture_say_scalar( { data => \@list, pred => 1, eval => $say_sub, msg => $msg, } ); @list = ( 'Hello', ' ', 'World', "\n" ); capture_say_scalar( { data => \@list, pred => 2, eval => $say_sub, msg => $msg, } ); @list = ( 'Hello', ' ', 'World', "\n", 'Again!', "\n" ); capture_say_scalar( { data => \@list, pred => 3, eval => $say_sub, msg => $msg, } ); @list = ( ); capture_say_scalar( { data => \@list, pred => 1, eval => $say_sub, msg => $msg, } ); ##### Lexical Filehandle: Arrow ##### $say_sub = sub { my $arg = shift; my $string = q{}; open my $fh, ">", \$string or croak $diagnostics{open}; select($fh); ref($arg eq q{ARRAY}) ? say @{$arg} : say $arg; close $fh or croak $diagnostics{close}; return $string; }; $msg= q{correctly printed to string via lexical filehandle, selected, arrow syntax}; @list = ( 'Hello', ' ', 'World' ); capture_say_scalar( { data => \@list, pred => 1, eval => $say_sub, msg => $msg, } ); @list = ( 'Hello', ' ', 'World', "\n" ); capture_say_scalar( { data => \@list, pred => 2, eval => $say_sub, msg => $msg, } ); @list = ( 'Hello', ' ', 'World', "\n", 'Again!', "\n" ); capture_say_scalar( { data => \@list, pred => 3, eval => $say_sub, msg => $msg, } ); @list = ( ); capture_say_scalar( { data => \@list, pred => 1, eval => $say_sub, msg => $msg, } ); } # End SKIP block