10624839896

Committed 30 Aug 2024 12:47AM UTC coverage: 80.187% (+0.4%) from 79.799%

Build # 10624839896

Build Type

push

github

Committed by

Commit Message

Run Details

3165 of 3947 relevant lines covered (80.19%)

81.25 hits per line

Source File
Press 'n' to go to next uncovered line, 'b' for previous

95.05

/t/command-exec.t

#!/usr/bin/env perl
use Test2::V0;
use Test2::Tools::Spec;
use Test2::Tools::Compare qw(bag);

use FindBin;
use lib $FindBin::Bin;
use App::perlbrew;
require 'test2_helpers.pl';
use PerlbrewTestHelpers qw(stderr_is);

mock_perlbrew_install("perl-5.12.3");
mock_perlbrew_install("perl-5.12.4");
mock_perlbrew_install("perl-5.14.1");
mock_perlbrew_install("perl-5.14.2");

describe 'perlbrew exec perl -E "say 42"' => sub {
    it "invokes all perls" => sub {
        mocked(
            App::perlbrew->new(qw(exec perl -E), "say 42"),
            sub {
                my ($mock, $app) = @_;

                my @perls = $app->installed_perls;

                $mock->expects("do_system_with_exit_code")->exactly(4)->returns(
                    sub {
                        my ($self, @args) = @_;

                        is \@args, ["perl", "-E", "say 42"], "arguments";

                        my ($perlbrew_bin_path, $perlbrew_perl_bin_path, @paths) = split(":", $ENV{PATH});

                        my $perl_installation = shift @perls;

                        is $perlbrew_bin_path,      App::Perlbrew::Path->new($App::perlbrew::PERLBREW_ROOT, "bin")->stringify(), "perlbrew_bin_path";
                        is $perlbrew_perl_bin_path, App::Perlbrew::Path->new($App::perlbrew::PERLBREW_ROOT, "perls", $perl_installation->{name}, "bin")->stringify(), "perls/". $perl_installation->{name} . "/bin";

                        return 0;
                    }
                );

                $app->run;
            }
        );
    };
};

describe 'perlbrew exec --with perl-5.12.3 perl -E "say 42"' => sub {
    it "invokes perl-5.12.3/bin/perl" => sub {
        mocked(
            App::perlbrew->new(qw(exec --with perl-5.12.3 perl -E), "say 42"),
            sub {
                my ($mock, $app) = @_;

                $mock->expects("do_system_with_exit_code")->returns(
                    sub {
                        my ($self, @args) = @_;

                        is \@args, ["perl", "-E", "say 42"];

                        my ($perlbrew_bin_path, $perlbrew_perl_bin_path, @paths) = split(":", $ENV{PATH});

                        is $perlbrew_bin_path,      App::Perlbrew::Path->new($App::perlbrew::PERLBREW_ROOT, "bin")->stringify;
                        is $perlbrew_perl_bin_path, App::Perlbrew::Path->new($App::perlbrew::PERLBREW_ROOT, "perls", "perl-5.12.3", "bin")->stringify;

                        return 0;
                    }
                );

                $app->run;
            }
        );
    };
};

describe 'perlbrew exec --with perl-5.14.1,perl-5.12.3,perl-5.14.2 perl -E "say 42"' => sub {
    it "invokes each perl in the specified order" => sub {
        mocked(
            App::perlbrew->new(qw(exec --with), "perl-5.14.1 perl-5.12.3 perl-5.14.2", qw(perl -E), "say 42"),
            sub {
                my ($mock, $app) = @_;

                my @perl_paths;

                $mock->expects("do_system_with_exit_code")->exactly(3)->returns(
                    sub {
                        my ($self, @args) = @_;
                        my ($perlbrew_bin_path, $perlbrew_perl_bin_path, @paths) = split(":", $ENV{PATH});
                        push @perl_paths, $perlbrew_perl_bin_path;
                        return 0;
                    }
                );

                $app->run;

                is \@perl_paths, [
                    App::Perlbrew::Path->new($App::perlbrew::PERLBREW_ROOT, "perls", "perl-5.14.1", "bin")->stringify,
                    App::Perlbrew::Path->new($App::perlbrew::PERLBREW_ROOT, "perls", "perl-5.12.3", "bin")->stringify,
                    App::Perlbrew::Path->new($App::perlbrew::PERLBREW_ROOT, "perls", "perl-5.14.2", "bin")->stringify,
                ];
            }
        );
    };
};

describe 'perlbrew exec --with perl-5.14.1,perl-foobarbaz, ' => sub {
    it "ignore the unrecognized 'perl-foobarbaz'" => sub {
        mocked(
            App::perlbrew->new(qw(exec --with), "perl-5.14.1 perl-foobarbaz", qw(perl -E), "say 42"),
            sub {
                my ($mock, $app) = @_;

                my @perl_paths;

                $mock->expects("do_system_with_exit_code")->returns(
                    sub {
                        my ($self, @args) = @_;
                        my ($perlbrew_bin_path, $perlbrew_perl_bin_path, @paths) = split(":", $ENV{PATH});
                        push @perl_paths, $perlbrew_perl_bin_path;
                        return 0;
                    }
                );

                $app->run;

                is \@perl_paths, [
                    App::Perlbrew::Path->new($App::perlbrew::PERLBREW_ROOT, "perls", "perl-5.14.1", "bin")->stringify(),
                ];
            },
        )
    };
};

describe 'perlbrew exec --with perl-5.14.1,5.14.1 ' => sub {
    it "exec 5.14.1 twice, since that is what is specified" => sub {
        mocked(
            App::perlbrew->new(qw(exec --with), "perl-5.14.1 5.14.1", qw(perl -E), "say 42"),
            sub {
                my ($mock, $app) = @_;

                my @perl_paths;

                $mock->expects("do_system_with_exit_code")->exactly(2)->returns(
                    sub {
                        my ($self, @args) = @_;
                        my ($perlbrew_bin_path, $perlbrew_perl_bin_path, @paths) = split(":", $ENV{PATH});
                        push @perl_paths, $perlbrew_perl_bin_path;
                        return 0;
                    }
                );

                $app->run;

                is \@perl_paths, [
                    App::Perlbrew::Path->new($App::perlbrew::PERLBREW_ROOT, "perls", "perl-5.14.1", "bin")->stringify,
                    App::Perlbrew::Path->new($App::perlbrew::PERLBREW_ROOT, "perls", "perl-5.14.1", "bin")->stringify,
                ];
            }
        )
    };
};

describe 'exec exit code' => sub {
    describe "logging" => sub {
        it "should work" => sub {
            mocked(
                App::perlbrew->new(qw(exec --with), "perl-5.14.1", qw(perl -E), "somesub 42"),
                sub {
                    my ($mock, $app) = @_;

                    $mock->expects("format_info_output")->exactly(1)->returns("format_info_output_value\n");
                    $mock->expects("do_system_with_exit_code")->exactly(1)->returns(7<<8);

                    my $mock2 = mocked('App::perlbrew');
                    $mock2->expects("do_exit_with_error_code")->exactly(1)->returns(sub { die "simulate exit\n" });

                    stderr_is sub {
                        eval { $app->run; 1; };
                    }, <<"OUT";
Command [perl -E 'somesub 42'] terminated with exit code 7 (\$? = 1792) under the following perl environment:
format_info_output_value
OUT

                    $mock2->verify;
                }
            )
        };

        it "should be quiet if asked" => sub {
            my $app = App::perlbrew->new(qw(exec --quiet --with), "perl-5.14.1", qw(perl -E), "somesub 42");

            my $mock = mocked($app);
            $mock->expects("format_info_output")->exactly(0)->returns('should not be called!');
            $mock->expects("do_system_with_exit_code")->exactly(1)->returns(7<<8);

            my $mock2 = mocked('App::perlbrew');
            $mock2->expects("do_exit_with_error_code")->exactly(1)->returns(sub { die "simulate exit\n" });

            stderr_is sub {
                eval { $app->run; 1; };
            }, '';

            $mock->verify;
            $mock2->verify;
        };

        it "should format info output for right perl" => sub {
            my $app = App::perlbrew->new(qw(exec --with), "perl-5.14.1", qw(perl -E), "somesub 42");

            my $mock = mocked($app);
            $mock->expects("format_info_output")->exactly(1)->returns(sub {
                my ($self) = @_;
                is $self->current_env, 'perl-5.14.1';
                like $self->installed_perl_executable('perl-5.14.1'), qr/perl-5.14.1/;
                "format_info_output_value\n";
            });
            $mock->expects("do_system_with_exit_code")->exactly(1)->returns(7<<8);

            my $mock2 = mocked('App::perlbrew');
            $mock2->expects("do_exit_with_error_code")->exactly(1)->returns(sub {
                die "simulate exit\n";
            });

            eval { $app->run; 1; };

            $mock->verify;
            $mock2->verify;
        };
    };

    describe "no halt-on-error" => sub {
        it "should exit with success code when several perls ran" => sub {
            my $mock2 = mocked('App::perlbrew')->expects("do_exit_with_error_code")->never;

            mocked(
                App::perlbrew->new(qw(exec --with), "perl-5.14.1 perl-5.14.1", qw(perl -E), "say 42"),
                sub {
                    my ($mock, $app) = @_;
                    $mock->expects("do_system_with_exit_code")->exactly(2)->returns(0);
                    $app->run;
                }
            );

            $mock2->verify;
        };

        it "should exit with error code " => sub {
            my $app = App::perlbrew->new(qw(exec --with), "perl-5.14.1", qw(perl -E), "say 42");

            my $mock = mocked($app);
            $mock->expects("format_info_output")->exactly(1)->returns('');
            $mock->expects("do_system_with_exit_code")->exactly(1)->returns(3<<8);

            my $mock2 = mocked('App::perlbrew')->expects("do_exit_with_error_code")->exactly(1)->returns(sub {
                my ($self, $code) = @_;
                is $code, 1; # exit with error, but don't propogate exact failure codes
                die "simulate exit\n";
            });


            ok !eval { $app->run; 1; };
            is $@, "simulate exit\n";

            $mock->verify;
            $mock2->verify;
        };

        it "should exit with error code when several perls ran" => sub {
            my $app = App::perlbrew->new(qw(exec --with), "perl-5.14.1 perl-5.14.1", qw(perl -E), "say 42");

            my $mock = mocked($app);
            $mock->expects("format_info_output")->exactly(1)->returns('');
            my $calls = 0;
            $mock->expects("do_system_with_exit_code")->exactly(2)->returns(sub {
                $calls++;
                return 0 if ($calls == 2); # second exec call successed
                return 3<<8; # first exec failed
            });

            my $mock2 = mocked('App::perlbrew')->expects("do_exit_with_error_code")->exactly(1)->returns(sub {
                my ($self, $code) = @_;
                is $code, 1; # exit with error, but don't propogate exact failure codes
                die "simulate exit\n";
            });

            ok !eval { $app->run; 1; };
            is $@, "simulate exit\n";

            $mock->verify;
            $mock2->verify;
        };
    };

    describe "halt-on-error" => sub {
        it "should exit with success code " => sub {
            my $app = App::perlbrew->new(qw(exec --halt-on-error --with), "perl-5.14.1", qw(perl -E), "say 42");
            my $mock = mocked('App::perlbrew')->expects("do_exit_with_error_code")->never;
            my $mock2 = mocked($app)->expects("do_system_with_exit_code")->exactly(1)->returns(0);
            $app->run;
            $mock->verify;
            $mock2->verify;
        };

        it "should exit with error code " => sub {
            my $app = App::perlbrew->new(qw(exec --halt-on-error --with), "perl-5.14.1", qw(perl -E), "say 42");

            my $mock = mocked($app);
            $mock->expects("format_info_output")->exactly(1)->returns('');
            $mock->expects("do_system_with_exit_code")->exactly(1)->returns(3<<8);

            my $mock2 = mocked('App::perlbrew')->expects("do_exit_with_error_code")->exactly(1)->returns(sub {
                my ($self, $code) = @_;
                is $code, 3;
                die "simulate exit\n";
            });

            ok !eval { $app->run; 1; };
            is $@, "simulate exit\n";

            $mock->verify;
            $mock2->verify;
        };

        it "should exit with code 255 if program terminated with signal or something" => sub {
            my $app = App::perlbrew->new(qw(exec --halt-on-error --with), "perl-5.14.1", qw(perl -E), "say 42");

            my $mock = mocked($app);
            $mock->expects("format_info_output")->exactly(1)->returns('');
            $mock->expects("do_system_with_exit_code")->exactly(1)->returns(-1);

            my $mock2 = mocked('App::perlbrew')->expects("do_exit_with_error_code")->exactly(1)->returns(sub {
                my ($self, $code) = @_;
                is $code, 255;
                die "simulate exit\n";
            });

            ok !eval { $app->run; 1; };
            is $@, "simulate exit\n";

            $mock->verify;
            $mock2->verify;
        };

        it "should exit with error code when several perls ran" => sub {
            my $app = App::perlbrew->new(qw(exec --halt-on-error --with), "perl-5.14.1 perl-5.14.1", qw(perl -E), "say 42");

            my $mock = mocked($app);
            $mock->expects("format_info_output")->exactly(1)->returns('');
            my $calls = 0;
            $mock->expects("do_system_with_exit_code")->exactly(2)->returns(sub {
                $calls++;
                return 7<<8 if $calls == 2;
                return 0;
            });

            my $mock2 = mocked('App::perlbrew')->expects("do_exit_with_error_code")->exactly(1)->returns(sub {
                my ($self, $code) = @_;
                is $code, 7;
                die "simulate exit\n";
            });

            ok !eval { $app->run; 1; };
            is $@, "simulate exit\n";

            $mock->verify;
            $mock2->verify;
        };
    };
};

describe "minimal perl version" => sub {
    it "only executes the needed version" => sub {
        my @perl_paths;
        my $app = App::perlbrew->new(qw(exec --min 5.014), qw(perl -E), "say 42");

        my $mock = mocked($app)->expects("do_system_with_exit_code")->exactly(2)->returns(sub {
            my ($self, @args) = @_;
            my ($perlbrew_bin_path, $perlbrew_perl_bin_path, @paths) = split(":", $ENV{PATH});
            push @perl_paths, $perlbrew_perl_bin_path;
            return 0;
        });

        $app->run;

        is \@perl_paths, bag {
            item(App::Perlbrew::Path->new($App::perlbrew::PERLBREW_ROOT, "perls", "perl-5.14.2", "bin")->stringify());
            item(App::Perlbrew::Path->new($App::perlbrew::PERLBREW_ROOT, "perls", "perl-5.14.1", "bin")->stringify());
            end();
        };

        $mock->verify;
    };
};

describe "maximum perl version" => sub {
    it "only executes the needed version" => sub {
        my @perl_paths;
        my $app = App::perlbrew->new(qw(exec --max 5.014), qw(perl -E), "say 42");

        my $mock = mocked($app)->expects("do_system_with_exit_code")->exactly(2)->returns(sub {
            my ($self, @args) = @_;
            my ($perlbrew_bin_path, $perlbrew_perl_bin_path, @paths) = split(":", $ENV{PATH});
            push @perl_paths, $perlbrew_perl_bin_path;
            return 0;
        });

        $app->run;

        # Don't care about the order, just the fact all of them were visited
        is \@perl_paths, bag {
            item(App::Perlbrew::Path->new($App::perlbrew::PERLBREW_ROOT, "perls", "perl-5.12.4", "bin")->stringify());
            item(App::Perlbrew::Path->new($App::perlbrew::PERLBREW_ROOT, "perls", "perl-5.12.3", "bin")->stringify());
        };

        $mock->verify;
    };
};

done_testing;

1	#!/usr/bin/env perl
2	use Test2::V0;	1✔
3	use Test2::Tools::Spec;	1✔
4	use Test2::Tools::Compare qw(bag);
5		1✔
6	use FindBin;	1✔
7	use lib $FindBin::Bin;	1✔
8	use App::perlbrew;	×
9	require 'test2_helpers.pl';
10	use PerlbrewTestHelpers qw(stderr_is);	1✔
11
12	mock_perlbrew_install("perl-5.12.3");	×
13	mock_perlbrew_install("perl-5.12.4");	×
14	mock_perlbrew_install("perl-5.14.1");	1✔
15	mock_perlbrew_install("perl-5.14.2");	1✔
16
17	describe 'perlbrew exec perl -E "say 42"' => sub {
18	it "invokes all perls" => sub {
19	mocked(
20	App::perlbrew->new(qw(exec perl -E), "say 42"),
21	sub {
22	my ($mock, $app) = @_;	1✔
23
24	my @perls = $app->installed_perls;	1✔
25
26	$mock->expects("do_system_with_exit_code")->exactly(4)->returns(
27	sub {
28	my ($self, @args) = @_;	1✔
29
30	is \@args, ["perl", "-E", "say 42"], "arguments";	1✔
31
32	my ($perlbrew_bin_path, $perlbrew_perl_bin_path, @paths) = split(":", $ENV{PATH});	1✔
33
34	my $perl_installation = shift @perls;	4✔
35
36	is $perlbrew_bin_path, App::Perlbrew::Path->new($App::perlbrew::PERLBREW_ROOT, "bin")->stringify(), "perlbrew_bin_path";	4✔
37	is $perlbrew_perl_bin_path, App::Perlbrew::Path->new($App::perlbrew::PERLBREW_ROOT, "perls", $perl_installation->{name}, "bin")->stringify(), "perls/". $perl_installation->{name} . "/bin";	4✔
38
39	return 0;	4✔
40	}
41	);	1✔
42
43	$app->run;	4✔
44	}
45	);	1✔
46	};	1✔
47	};	1✔
48
49	describe 'perlbrew exec --with perl-5.12.3 perl -E "say 42"' => sub {
50	it "invokes perl-5.12.3/bin/perl" => sub {
51	mocked(
52	App::perlbrew->new(qw(exec --with perl-5.12.3 perl -E), "say 42"),
53	sub {
54	my ($mock, $app) = @_;	1✔
55
56	$mock->expects("do_system_with_exit_code")->returns(
57	sub {
58	my ($self, @args) = @_;	1✔
59
60	is \@args, ["perl", "-E", "say 42"];	1✔
61
62	my ($perlbrew_bin_path, $perlbrew_perl_bin_path, @paths) = split(":", $ENV{PATH});	1✔
63
64	is $perlbrew_bin_path, App::Perlbrew::Path->new($App::perlbrew::PERLBREW_ROOT, "bin")->stringify;	1✔
65	is $perlbrew_perl_bin_path, App::Perlbrew::Path->new($App::perlbrew::PERLBREW_ROOT, "perls", "perl-5.12.3", "bin")->stringify;	1✔
66
67	return 0;	1✔
68	}
69	);	1✔
70
71	$app->run;	1✔
72	}
73	);	1✔
74	};	4✔
75	};	4✔
76
77	describe 'perlbrew exec --with perl-5.14.1,perl-5.12.3,perl-5.14.2 perl -E "say 42"' => sub {
78	it "invokes each perl in the specified order" => sub {
79	mocked(
80	App::perlbrew->new(qw(exec --with), "perl-5.14.1 perl-5.12.3 perl-5.14.2", qw(perl -E), "say 42"),
81	sub {
82	my ($mock, $app) = @_;	1✔
83
84	my @perl_paths;	1✔
85
86	$mock->expects("do_system_with_exit_code")->exactly(3)->returns(
87	sub {
88	my ($self, @args) = @_;	1✔
89	my ($perlbrew_bin_path, $perlbrew_perl_bin_path, @paths) = split(":", $ENV{PATH});	1✔
90	push @perl_paths, $perlbrew_perl_bin_path;	1✔
91	return 0;	3✔
92	}
93	);	1✔
94
95	$app->run;	3✔
96
97	is \@perl_paths, [	3✔
98	App::Perlbrew::Path->new($App::perlbrew::PERLBREW_ROOT, "perls", "perl-5.14.1", "bin")->stringify,
99	App::Perlbrew::Path->new($App::perlbrew::PERLBREW_ROOT, "perls", "perl-5.12.3", "bin")->stringify,
100	App::Perlbrew::Path->new($App::perlbrew::PERLBREW_ROOT, "perls", "perl-5.14.2", "bin")->stringify,
101	];
102	}
103	);	1✔
104	};	1✔
105	};	1✔
106
107	describe 'perlbrew exec --with perl-5.14.1,perl-foobarbaz, ' => sub {
108	it "ignore the unrecognized 'perl-foobarbaz'" => sub {
109	mocked(
110	App::perlbrew->new(qw(exec --with), "perl-5.14.1 perl-foobarbaz", qw(perl -E), "say 42"),
111	sub {
112	my ($mock, $app) = @_;	1✔
113
114	my @perl_paths;	1✔
115
116	$mock->expects("do_system_with_exit_code")->returns(
117	sub {
118	my ($self, @args) = @_;	1✔
119	my ($perlbrew_bin_path, $perlbrew_perl_bin_path, @paths) = split(":", $ENV{PATH});	1✔
120	push @perl_paths, $perlbrew_perl_bin_path;	1✔
121	return 0;	1✔
122	}
123	);	1✔
124
125	$app->run;	1✔
126
127	is \@perl_paths, [	1✔
128	App::Perlbrew::Path->new($App::perlbrew::PERLBREW_ROOT, "perls", "perl-5.14.1", "bin")->stringify(),
129	];
130	},
131	)
132	};	1✔
133	};	3✔
134
135	describe 'perlbrew exec --with perl-5.14.1,5.14.1 ' => sub {
136	it "exec 5.14.1 twice, since that is what is specified" => sub {
137	mocked(
138	App::perlbrew->new(qw(exec --with), "perl-5.14.1 5.14.1", qw(perl -E), "say 42"),
139	sub {
140	my ($mock, $app) = @_;	1✔
141
142	my @perl_paths;	1✔
143
144	$mock->expects("do_system_with_exit_code")->exactly(2)->returns(
145	sub {
146	my ($self, @args) = @_;	1✔
147	my ($perlbrew_bin_path, $perlbrew_perl_bin_path, @paths) = split(":", $ENV{PATH});	1✔
148	push @perl_paths, $perlbrew_perl_bin_path;	1✔
149	return 0;	2✔
150	}
151	);	1✔
152
153	$app->run;	2✔
154
155	is \@perl_paths, [	2✔
156	App::Perlbrew::Path->new($App::perlbrew::PERLBREW_ROOT, "perls", "perl-5.14.1", "bin")->stringify,
157	App::Perlbrew::Path->new($App::perlbrew::PERLBREW_ROOT, "perls", "perl-5.14.1", "bin")->stringify,
158	];
159	}
160	)
161	};	1✔
162	};	1✔
163
164	describe 'exec exit code' => sub {
165	describe "logging" => sub {
166	it "should work" => sub {
167	mocked(
168	App::perlbrew->new(qw(exec --with), "perl-5.14.1", qw(perl -E), "somesub 42"),
169	sub {
170	my ($mock, $app) = @_;	1✔
171
172	$mock->expects("format_info_output")->exactly(1)->returns("format_info_output_value\n");	1✔
173	$mock->expects("do_system_with_exit_code")->exactly(1)->returns(7<<8);	1✔
174
175	my $mock2 = mocked('App::perlbrew');	1✔
176	$mock2->expects("do_exit_with_error_code")->exactly(1)->returns(sub { die "simulate exit\n" });	1✔
177
178	stderr_is sub {
179	eval { $app->run; 1; };	1✔
180	}, <<"OUT";	1✔
181	Command [perl -E 'somesub 42'] terminated with exit code 7 (\$? = 1792) under the following perl environment:
182	format_info_output_value
183	OUT
184
185	$mock2->verify;	1✔
186	}
187	)
188	};	1✔
189
190	it "should be quiet if asked" => sub {
191	my $app = App::perlbrew->new(qw(exec --quiet --with), "perl-5.14.1", qw(perl -E), "somesub 42");	×
192
193	my $mock = mocked($app);	1✔
194	$mock->expects("format_info_output")->exactly(0)->returns('should not be called!');	1✔
195	$mock->expects("do_system_with_exit_code")->exactly(1)->returns(7<<8);	1✔
196
197	my $mock2 = mocked('App::perlbrew');	1✔
198	$mock2->expects("do_exit_with_error_code")->exactly(1)->returns(sub { die "simulate exit\n" });	1✔
199
200	stderr_is sub {
201	eval { $app->run; 1; };	1✔
202	}, '';	1✔
203
204	$mock->verify;	1✔
205	$mock2->verify;	1✔
206	};	1✔
207
208	it "should format info output for right perl" => sub {
209	my $app = App::perlbrew->new(qw(exec --with), "perl-5.14.1", qw(perl -E), "somesub 42");	1✔
210
211	my $mock = mocked($app);	1✔
212	$mock->expects("format_info_output")->exactly(1)->returns(sub {
213	my ($self) = @_;	1✔
214	is $self->current_env, 'perl-5.14.1';	1✔
215	like $self->installed_perl_executable('perl-5.14.1'), qr/perl-5.14.1/;	1✔
216	"format_info_output_value\n";	1✔
217	});	1✔
218	$mock->expects("do_system_with_exit_code")->exactly(1)->returns(7<<8);	1✔
219
220	my $mock2 = mocked('App::perlbrew');	1✔
221	$mock2->expects("do_exit_with_error_code")->exactly(1)->returns(sub {
222	die "simulate exit\n";	1✔
223	});	1✔
224
225	eval { $app->run; 1; };	1✔
226
227	$mock->verify;	1✔
228	$mock2->verify;	1✔
229	};	×
230	};	1✔
231
232	describe "no halt-on-error" => sub {
233	it "should exit with success code when several perls ran" => sub {
234	my $mock2 = mocked('App::perlbrew')->expects("do_exit_with_error_code")->never;	1✔
235
236	mocked(
237	App::perlbrew->new(qw(exec --with), "perl-5.14.1 perl-5.14.1", qw(perl -E), "say 42"),
238	sub {
239	my ($mock, $app) = @_;	1✔
240	$mock->expects("do_system_with_exit_code")->exactly(2)->returns(0);	1✔
241	$app->run;	1✔
242	}
243	);	1✔
244
245	$mock2->verify;	1✔
246	};	1✔
247
248	it "should exit with error code " => sub {
249	my $app = App::perlbrew->new(qw(exec --with), "perl-5.14.1", qw(perl -E), "say 42");	1✔
250
251	my $mock = mocked($app);	1✔
252	$mock->expects("format_info_output")->exactly(1)->returns('');	1✔
253	$mock->expects("do_system_with_exit_code")->exactly(1)->returns(3<<8);	1✔
254
255	my $mock2 = mocked('App::perlbrew')->expects("do_exit_with_error_code")->exactly(1)->returns(sub {
256	my ($self, $code) = @_;	1✔
257	is $code, 1; # exit with error, but don't propogate exact failure codes	1✔
258	die "simulate exit\n";	1✔
259	});	1✔
260
261
262	ok !eval { $app->run; 1; };	1✔
263	is $@, "simulate exit\n";	1✔
264
265	$mock->verify;	1✔
266	$mock2->verify;	×
267	};	1✔
268
269	it "should exit with error code when several perls ran" => sub {
270	my $app = App::perlbrew->new(qw(exec --with), "perl-5.14.1 perl-5.14.1", qw(perl -E), "say 42");	1✔
271
272	my $mock = mocked($app);	1✔
273	$mock->expects("format_info_output")->exactly(1)->returns('');	1✔
274	my $calls = 0;	1✔
275	$mock->expects("do_system_with_exit_code")->exactly(2)->returns(sub {
276	$calls++;	1✔
277	return 0 if ($calls == 2); # second exec call successed	1✔
278	return 3<<8; # first exec failed	1✔
279	});	1✔
280
281	my $mock2 = mocked('App::perlbrew')->expects("do_exit_with_error_code")->exactly(1)->returns(sub {
282	my ($self, $code) = @_;	2✔
283	is $code, 1; # exit with error, but don't propogate exact failure codes	1✔
284	die "simulate exit\n";	1✔
285	});	2✔
286
287	ok !eval { $app->run; 1; };	1✔
288	is $@, "simulate exit\n";	1✔
289
290	$mock->verify;	1✔
291	$mock2->verify;	×
292	};	1✔
293	};	×
294
295	describe "halt-on-error" => sub {
296	it "should exit with success code " => sub {
297	my $app = App::perlbrew->new(qw(exec --halt-on-error --with), "perl-5.14.1", qw(perl -E), "say 42");	1✔
298	my $mock = mocked('App::perlbrew')->expects("do_exit_with_error_code")->never;	1✔
299	my $mock2 = mocked($app)->expects("do_system_with_exit_code")->exactly(1)->returns(0);	1✔
300	$app->run;	1✔
301	$mock->verify;	1✔
302	$mock2->verify;	1✔
303	};	1✔
304
305	it "should exit with error code " => sub {
306	my $app = App::perlbrew->new(qw(exec --halt-on-error --with), "perl-5.14.1", qw(perl -E), "say 42");	1✔
307
308	my $mock = mocked($app);	1✔
309	$mock->expects("format_info_output")->exactly(1)->returns('');	1✔
310	$mock->expects("do_system_with_exit_code")->exactly(1)->returns(3<<8);	1✔
311
312	my $mock2 = mocked('App::perlbrew')->expects("do_exit_with_error_code")->exactly(1)->returns(sub {
313	my ($self, $code) = @_;	1✔
314	is $code, 3;	1✔
315	die "simulate exit\n";	1✔
316	});	1✔
317
318	ok !eval { $app->run; 1; };	1✔
319	is $@, "simulate exit\n";	1✔
320
321	$mock->verify;	1✔
322	$mock2->verify;	×
323	};	1✔
324
325	it "should exit with code 255 if program terminated with signal or something" => sub {
326	my $app = App::perlbrew->new(qw(exec --halt-on-error --with), "perl-5.14.1", qw(perl -E), "say 42");	1✔
327
328	my $mock = mocked($app);	1✔
329	$mock->expects("format_info_output")->exactly(1)->returns('');	1✔
330	$mock->expects("do_system_with_exit_code")->exactly(1)->returns(-1);	1✔
331
332	my $mock2 = mocked('App::perlbrew')->expects("do_exit_with_error_code")->exactly(1)->returns(sub {
333	my ($self, $code) = @_;	1✔
334	is $code, 255;	1✔
335	die "simulate exit\n";	1✔
336	});	1✔
337
338	ok !eval { $app->run; 1; };	1✔
339	is $@, "simulate exit\n";	1✔
340
341	$mock->verify;	1✔
342	$mock2->verify;	×
343	};	1✔
344
345	it "should exit with error code when several perls ran" => sub {
346	my $app = App::perlbrew->new(qw(exec --halt-on-error --with), "perl-5.14.1 perl-5.14.1", qw(perl -E), "say 42");	1✔
347
348	my $mock = mocked($app);	1✔
349	$mock->expects("format_info_output")->exactly(1)->returns('');	1✔
350	my $calls = 0;	1✔
351	$mock->expects("do_system_with_exit_code")->exactly(2)->returns(sub {
352	$calls++;	1✔
353	return 7<<8 if $calls == 2;	1✔
354	return 0;	1✔
355	});	1✔
356
357	my $mock2 = mocked('App::perlbrew')->expects("do_exit_with_error_code")->exactly(1)->returns(sub {
358	my ($self, $code) = @_;	2✔
359	is $code, 7;	1✔
360	die "simulate exit\n";	1✔
361	});	2✔
362
363	ok !eval { $app->run; 1; };	1✔
364	is $@, "simulate exit\n";	1✔
365
366	$mock->verify;	1✔
367	$mock2->verify;	×
368	};	1✔
369	};	1✔
370	};	2✔
371
372	describe "minimal perl version" => sub {
373	it "only executes the needed version" => sub {
374	my @perl_paths;	1✔
375	my $app = App::perlbrew->new(qw(exec --min 5.014), qw(perl -E), "say 42");	1✔
376
377	my $mock = mocked($app)->expects("do_system_with_exit_code")->exactly(2)->returns(sub {
378	my ($self, @args) = @_;	1✔
379	my ($perlbrew_bin_path, $perlbrew_perl_bin_path, @paths) = split(":", $ENV{PATH});	1✔
380	push @perl_paths, $perlbrew_perl_bin_path;	1✔
381	return 0;	2✔
382	});	1✔
383
384	$app->run;	2✔
385
386	is \@perl_paths, bag {
387	item(App::Perlbrew::Path->new($App::perlbrew::PERLBREW_ROOT, "perls", "perl-5.14.2", "bin")->stringify());	2✔
388	item(App::Perlbrew::Path->new($App::perlbrew::PERLBREW_ROOT, "perls", "perl-5.14.1", "bin")->stringify());
389	end();
390	};
391
392	$mock->verify;	2✔
393	};	1✔
394	};	1✔
395
396	describe "maximum perl version" => sub {
397	it "only executes the needed version" => sub {
398	my @perl_paths;	1✔
399	my $app = App::perlbrew->new(qw(exec --max 5.014), qw(perl -E), "say 42");	1✔
400
401	my $mock = mocked($app)->expects("do_system_with_exit_code")->exactly(2)->returns(sub {
402	my ($self, @args) = @_;	1✔
403	my ($perlbrew_bin_path, $perlbrew_perl_bin_path, @paths) = split(":", $ENV{PATH});	1✔
404	push @perl_paths, $perlbrew_perl_bin_path;	1✔
405	return 0;	2✔
406	});	1✔
407
408	$app->run;	2✔
409
410	# Don't care about the order, just the fact all of them were visited
411	is \@perl_paths, bag {	2✔
412	item(App::Perlbrew::Path->new($App::perlbrew::PERLBREW_ROOT, "perls", "perl-5.12.4", "bin")->stringify());
413	item(App::Perlbrew::Path->new($App::perlbrew::PERLBREW_ROOT, "perls", "perl-5.12.3", "bin")->stringify());
414	};
415
416	$mock->verify;	2✔
417	};	1✔
418	};	1✔
419
420	done_testing;	1✔

gugod / App-perlbrew / 10624839896

Source File Press 'n' to go to next uncovered line, 'b' for previous

Source File
Press 'n' to go to next uncovered line, 'b' for previous