p6.p6

use v6;
use lib $?FILE.IO.parent(2).add("packages");
use Test;
use Test::Util;

plan 30;

# Tests for IO::CatHandle class

sub make-files (*@content) {
    my @ret = @content.map: {
        when IO::Handle { $_ }
        make-temp-file content => $_
    }

    # Create a random mix of IO::Paths and IO::Handles
    @ret[$_] .= open for @ret.keys.pick: [max] 1, @ret/3;

    # Make some of the items Str objects
    @ret[$_] .= IO .= absolute for @ret.keys.pick: [max] 1, @ret/3;
    @ret
}


subtest 'split method' => {
    sub cat { IO::CatHandle.new: make-files 'fo♥', 'b♥r', 'meow' }
    my $str = 'fo♥b♥rmeow';
    my @tests = \(''), \('♥'), \('♥', 2), \(0), \(1), \(5), \(1000),
        \(2, 3), \(/../), \(/../, 2), \(/<:alpha>/, 3),
        \('', :skip-empty), \('♥', :k), \('♥', :v), \(0, :kv), \(1, :p),
        \(5, :skip-empty, :k), \(1000, :skip-empty, :v),
        \(2, 3, :skip-empty, :kv), \(/../, :skip-empty, :p),
        \(/../, 2, :skip-empty, :p), \(/<:alpha>/, 3, :skip-empty, :kv);
    plan +@tests;

    is-deeply cat.split(|$_), $str.split(|$_), .perl for @tests;
}

subtest 'Str method' => {
    plan 4;

    my @files = make-files <foo bar ber>;
    my @paths = map *.IO, @files;
    my $cat = IO::CatHandle.new: @files;
    is-deeply $cat.Str, @paths[0].Str, '1';
    $cat.read: 4;
    is-deeply $cat.Str, @paths[1].Str, '2';
    $cat.read: 4;
    is-deeply $cat.Str, @paths[2].Str, '3';

    # Don't spec the exact content of .Str on closed handle
    # (Rakudo tests in own test suite):
    $cat.read: 1000;
    isa-ok $cat.Str, Str, '4';
}

#?rakudo.jvm skip 'UnwindException'
#?DOES 1
{
  subtest 'Supply method' => {
    plan 5;
    my @pieces = 'fo♥', 'b♥r', '', 'meow';
    my $str = [~] @pieces;
    sub cat-supply (
        Capture \cat-args    = \(),
        Capture \supply-args = \(),
        @bits = @pieces,
    ) {
        my @res;
        my IO::CatHandle $cat .= new: |cat-args, make-files @bits;
        react whenever $cat.Supply: |supply-args { @res.push: $_ }
        @res;
    }

    subtest 'binary cat' => { plan 4;
        is-deeply cat-supply(\(:bin)), [buf8.new: $str.encode], 'no args';
        is-deeply cat-supply(\(:bin), \(:2size)), [
            $str.encode.batch(2).map: {buf8.new: $_}
        ], 'size 2';
        is-deeply cat-supply(\(:bin), \(:5size)), [
            $str.encode.batch(5).map: {buf8.new: $_}
        ], 'size 5';
        is-deeply cat-supply(\(:bin), \(:1000size)), [buf8.new: $str.encode],
          'size 1000';
    }

    subtest 'non-binary cat, utf8-c8' => { plan 4;
        my \c = \(:encoding<utf8-c8>);
        my @bits = buf8.new(200), buf8.new(200, 200), buf8.new(200, 42, 70);
        #?rakudo.jvm emit # Unsupported VM encoding 'utf8-c8'
        my $str = ([~] @bits).decode: 'utf8-c8';
        #?rakudo.moar 4 todo 'readchars reads wrong num of chars RT131383'
        #?rakudo.jvm 4 skip "Unsupported VM encoding 'utf8-c8'"
        is-deeply cat-supply(c, \(         ), @bits), [$str],        'no args';
        is-deeply cat-supply(c, \(:2size   ), @bits), [$str.comb: 2], 'size 2';
        is-deeply cat-supply(c, \(:5size   ), @bits), [$str.comb: 5], 'size 5';
        is-deeply cat-supply(c, \(:1000size), @bits), [$str],      'size 1000';
}

    {
        my IO::CatHandle $cat .= new: make-files @pieces;
        $cat.slurp;
        my @res;
        react whenever $cat.Supply { @res.push: $_ }
        is-deeply @res, [], 'supply on exhausted cat is empty';
        react whenever $cat.Supply { @res.push: $_ }
        is-deeply @res, [], 'supply on exhausted cat is empty (second call)';
}
  }
}

subtest 't method' => {
    plan 4;
    my $tty = do {
        my $tt = shell :out, :err, 'tty';
        if $tt and (my $path = $tt.out.slurp(:close).trim)
          and $path ne 'not a tty' and my $fh = $path.IO.open {
            $fh
        }
        else {
            make-temp-file(:content<foo>).open
        }
    }

    my $cat = IO::CatHandle.new: make-files 'foo', $tty, 'bar';
    is-deeply $cat.t, False,  '1';
    $cat.next-handle;
    is-deeply $cat.t, $tty.t, '2';
    $cat.next-handle;
    is-deeply $cat.t, False,  '3';
    $cat.next-handle;
    is-deeply $cat.t, False,  'after exhausting handles';
    $cat.close;
}

# subtest 'lock method' => {
#
#    This method is tested in S32-io/lock.t
#
# }

subtest 'words method' => {
    plan 13;
    my $exp = ('a'..'z').list.Seq;
    sub files { make-files ('a'..'z').rotor(6, :partial)».join: " " }

    is-deeply IO::CatHandle.new(files).words,      $exp,         'no arg';
    is-deeply IO::CatHandle.new(files).words(500), $exp,         '$limit 500';
    is-deeply IO::CatHandle.new(files).words(5),   $exp.head(5), '$limit 5';

    my @files = files;
    is-deeply IO::CatHandle.new(@files).words(0), $exp.head(0),
        '$limit 0 (return value)';
    is-deeply @files.grep(IO::Handle).grep(*.opened.not).elems, 0,
        '$limit 0 (all opened handles remained open)';

    @files = files;
    is-deeply IO::CatHandle.new(@files).words(:close), $exp,
        ':close arg (return value)';
    is-deeply @files.grep(IO::Handle).grep(*.opened).elems, 0,
        ':close arg (all opened handles got closed)';

    @files = files;
    is-deeply IO::CatHandle.new(@files).words(500, :close), $exp,
        '$limit 500, :close arg (return value)';
    is-deeply @files.grep(IO::Handle).grep(*.opened).elems, 0,
        '$limit 500, :close arg (all opened handles got closed)';

    @files = files;
    is-deeply IO::CatHandle.new(@files).words(5, :close), $exp.head(5),
        '$limit 5, :close arg (return value)';
    is-deeply @files.grep(IO::Handle).grep(*.opened).elems, 0,
        '$limit 5, :close arg (all opened handles got closed)';

    @files = files;
    is-deeply IO::CatHandle.new(@files).words(0, :close), $exp.head(0),
        '$limit 0, :close arg (return value)';
    is-deeply @files.grep(IO::Handle).grep(*.opened).elems, 0,
        '$limit 0, :close arg (all opened handles got closed)';
}

if $*DISTRO.is-win {
    skip "Proc/Proc::Async with cmd.exe don't quite work on Windows: RT132258";
}
else {
    # https://github.com/rakudo/rakudo/issues/1313
    {
      subtest 'IO::CatHandle.read does not switch to another handle too early' => {
        plan 2;

        my $p := run $*EXECUTABLE, '-e', ｢
            my $b := buf8.new;
            $b.append: $*ARGFILES.read: 1000 for ^100;
            $b.List.put;
        ｣, :in, :out, :err;
        $p.in.print: "ab";
        $p.in.flush;
        sleep .6; # seems to be needed to ensure first print gets sent right away
        $p.in.print: "cd";
        $p.in.close;

        is $p.out.slurp(:close), "97 98 99 100\n", 'got all elements';
        is $p.err.slurp(:close), '', 'STDERR is empty';
      }
    }
}

# vim: ft=perl6 expandtab sw=4