redirect_stack.t 2.21 KB
Newer Older
1 2
#!/usr/bin/env perl

3
# Copyright [1999-2015] Wellcome Trust Sanger Institute and the EMBL-European Bioinformatics Institute
Brandon Walts's avatar
Brandon Walts committed
4
# Copyright [2016-2020] EMBL-European Bioinformatics Institute
5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23
# 
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
# 
#      http://www.apache.org/licenses/LICENSE-2.0
# 
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.


use strict;
use warnings;

use Test::More tests => 8;

24
use Cwd 'getcwd';
25 26 27 28 29 30 31 32 33
use Capture::Tiny ':all';
use File::Temp qw{tempdir};

BEGIN {
    use_ok( 'Bio::EnsEMBL::Hive::Utils::RedirectStack' );
}
#########################

my $dir = tempdir CLEANUP => 1;
34 35
my $original = getcwd;
chdir $dir;
36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64

my $rs_stdout = Bio::EnsEMBL::Hive::Utils::RedirectStack->new(\*STDOUT);
my $stdout = capture_stdout {
    print "Message 1\n";            # gets displayed on the screen
    $rs_stdout->push('foo');
        print "Message 2\n";            # goes to 'foo'
        $rs_stdout->push('bar');
            print "Message 3\n";            # goes to 'bar'
            system('echo subprocess A');    # it works for subprocesses too
            $rs_stdout->pop;
        print "Message 4\n";            # goes to 'foo'
        system('echo subprocess B');    # again, works for subprocesses as well
        $rs_stdout->push('baz');
            print "Message 5\n";            # goest to 'baz'
            $rs_stdout->pop;
        print "Message 6\n";            # goes to 'foo'
        $rs_stdout->pop;
    print "Message 7\n";            # gets displayed on the screen
};

is($stdout, qq{Message 1\nMessage 7\n}, 'stdout output');
ok(-e 'foo', '"foo" exists');
is(`cat foo`, qq{Message 2\nMessage 4\nsubprocess B\nMessage 6\n}, 'foo output');
ok(-e 'bar', '"bar" exists');
is(`cat bar`, qq{Message 3\nsubprocess A\n}, 'bar output');
ok(-e 'baz', '"bar" exists');
is(`cat baz`, qq{Message 5\n}, 'baz output');

done_testing();
65 66 67

chdir $original;