The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.
#  !perl
#$Id: 05_scalar_ref.t 1215 2008-02-09 23:46:05Z jimk $
# 05_scalar_ref.t - test say() when printing to string via reference to scalar
use strict;
use warnings;
use Test::More tests => 27;
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);

##### Global Filehandle:  Direct #####


SKIP: {
    my $skipped_tests = (27 - 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 $@;
    
    $say_sub = sub {
        my $arg = shift;
        my $string = q{};
        open FH, ">", \$string or croak $diagnostics{open};
        ref($arg eq q{ARRAY}) ? say FH @{$arg} : say FH $arg;
        close FH or croak $diagnostics{close};
        return $string;
    };
    $msg= q{correctly printed to string via global filehandle};
    
    @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};
        ref($arg eq q{ARRAY}) ? FH->say(@{$arg}) : FH->say($arg);
        close FH or croak $diagnostics{close};
        return $string;
    };
    $msg= q{correctly printed to string via global filehandle, 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,
    } );
    
    ##### Global Filehandle: Typeglob  #####
    
    $say_sub = sub {
        my $arg = shift;
        my $string = q{};
        open FH, ">", \$string or croak $diagnostics{open};
        ref($arg eq q{ARRAY}) ? *FH->say(@{$arg}) : *FH->say($arg);
        close FH or croak $diagnostics{close};
        return $string;
    };
    $msg= q{correctly printed to string via global filehandle, typeglob 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,
    } );
    
    ##### Global Filehandle: Reference to Typeglob  #####
    
    $say_sub = sub {
        my $arg = shift;
        my $string = q{};
        open FH, ">", \$string or croak $diagnostics{open};
        ref($arg eq q{ARRAY}) ? (*FH)->say(@{$arg}) : (*FH)->say($arg);
        close FH or croak $diagnostics{close};
        return $string;
    };
    $msg= q{correctly printed to string via global filehandle, ref to typeglob 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};
        ref($arg eq q{ARRAY}) ? say $fh, @{$arg} : say $fh, $arg;
        close $fh or croak $diagnostics{close};
        return $string;
    };
    $msg= q{correctly printed to string via lexical filehandle, 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};
        ref($arg eq q{ARRAY}) ? $fh->say(@{$arg}) : $fh->say($arg);
        close $fh or croak $diagnostics{close};
        return $string;
    };
    $msg= q{correctly printed to string via lexical filehandle, 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