From 0e53bac29f878d3aed5b42581b14994028ece78e Mon Sep 17 00:00:00 2001 From: Kang-min Liu Date: Sun, 14 Jul 2024 21:44:05 +0900 Subject: [PATCH 1/4] rewrite some Test::Spec code simply as the nested `subtest` from Test2 --- t/home.t | 43 +++++++++++-------------------------------- 1 file changed, 11 insertions(+), 32 deletions(-) diff --git a/t/home.t b/t/home.t index 1ad3f2fe..8dd0d47a 100644 --- a/t/home.t +++ b/t/home.t @@ -1,13 +1,9 @@ #!/usr/bin/env perl -use strict; -use warnings; +use Test2::V0; use FindBin; use lib $FindBin::Bin; use App::perlbrew; -require "test_helpers.pl"; - -use Test::Deep qw[]; -use Test::Spec; +require "test2_helpers.pl"; sub looks_like_perlbrew_home; @@ -15,14 +11,14 @@ local $App::perlbrew::PERLBREW_HOME = '/perlbrew/home'; local $ENV{PERLBREW_HOME} = '/env/home'; local $ENV{HOME} = '/home'; -describe "App::perlbrew#home method" => sub { - it "should return \$App::perlbrew::PERLBREW_HOME if provided" => sub { +subtest "App::perlbrew#home method" => sub { + subtest "it should return \$App::perlbrew::PERLBREW_HOME if provided" => sub { my $app = App::perlbrew->new; looks_like_perlbrew_home $app->home, '/perlbrew/home'; }; - it "should default to \$ENV{PERLBREW_HOME} if provided" => sub { + subtest "it should default to \$ENV{PERLBREW_HOME} if provided" => sub { local $App::perlbrew::PERLBREW_HOME; my $app = App::perlbrew->new; @@ -30,7 +26,7 @@ describe "App::perlbrew#home method" => sub { looks_like_perlbrew_home $app->home, '/env/home'; }; - it "should default to \$ENV{HOME} subpath" => sub { + subtest "it should default to \$ENV{HOME} subpath" => sub { local $App::perlbrew::PERLBREW_HOME; local $ENV{PERLBREW_HOME}; @@ -39,7 +35,7 @@ describe "App::perlbrew#home method" => sub { looks_like_perlbrew_home $app->home, '/home/.perlbrew'; }; - it "should return the instance property of 'home' if set" => sub { + subtest "it should return the instance property of 'home' if set" => sub { my $app = App::perlbrew->new; $app->home("/fnord"); @@ -47,29 +43,12 @@ describe "App::perlbrew#home method" => sub { }; }; -runtests unless caller; +done_testing; sub looks_like_perlbrew_home { my ($got, $expected) = @_; - my ($ok, $stack); - - ($ok, $stack) = Test::Deep::cmp_details "$got", "$expected"; - unless ($ok) { - fail; - diag "Return value comparison failed"; - diag Test::Deep::deep_diag $stack; - return; - } - - ($ok, $stack) = Test::Deep::cmp_details "$got", "$App::perlbrew::PERLBREW_HOME"; - unless ($ok) { - fail; - diag "Global \$PERLBREW_HOME comparison failed"; - diag Test::Deep::deep_diag $stack; - return; - } - - return Test::Deep::cmp_deeply $got, Isa('App::Perlbrew::Path'); + isa_ok $got, 'App::Perlbrew::Path'; + is "$got", "$expected"; + is "$got", "$App::perlbrew::PERLBREW_HOME"; } - From a8149aa8c02f9bd57dd3634ca91a6bfb3b3c063c Mon Sep 17 00:00:00 2001 From: Kang-min Liu Date: Fri, 26 Jul 2024 07:30:05 +0900 Subject: [PATCH 2/4] rewrite test cases in command-help.t with Test2 --- t/command-help.t | 61 +++++++++++++++++++----------------------------- 1 file changed, 24 insertions(+), 37 deletions(-) diff --git a/t/command-help.t b/t/command-help.t index d609fbfa..fd36e8f5 100644 --- a/t/command-help.t +++ b/t/command-help.t @@ -1,12 +1,9 @@ #!/usr/bin/env perl -use strict; -use warnings; +use Test2::V0; use FindBin; use lib $FindBin::Bin; use App::perlbrew; -require "test_helpers.pl"; - -use Test::Spec; +require "test2_helpers.pl"; my $bin_perlbrew = file(__FILE__)->dirname->dirname->child("script")->child("perlbrew"); my $perl = $^X; @@ -16,45 +13,35 @@ my $perl = $^X; # that's why we use backtick to test. # - -describe "`perlbrew`" => sub { - it "should print some nice message and instruct user to read help for individual commands" => sub { - my $out = `$perl -Ilib $bin_perlbrew help`; - like $out, qr/perlbrew help /si; - }; +subtest "`perlbrew` should print some nice message and instruct user to read help for individual commands" => sub { + my $out = `$perl -Ilib $bin_perlbrew help`; + like $out, qr/perlbrew help /si; }; -describe "`perlbrew -h`" => sub { - it "should print short version of help message and instruct user to read longer version" => sub { - my $out1 = `$perl -Ilib $bin_perlbrew --help`; - my $out2 = `$perl -Ilib $bin_perlbrew -h`; +subtest "`perlbrew -h` should print short version of help message and instruct user to read longer version" => sub { + my $out1 = `$perl -Ilib $bin_perlbrew --help`; + my $out2 = `$perl -Ilib $bin_perlbrew -h`; - is $out2, $out1; - like $out1, qr/^ See `perlbrew help` for the full documentation/m; - unlike $out1, qr/^CONFIGURATION$/m; - }; + is $out2, $out1; + like $out1, qr/^ See `perlbrew help` for the full documentation/m; + unlike $out1, qr/^CONFIGURATION$/m; }; -describe "`perlbrew help`" => sub { - it "should should the lengthy version " => sub { - my $out = `$perl -Ilib $bin_perlbrew help`; - like $out, qr/^CONFIGURATION$/m; - }; - - it "should instruct user to read help for individual commands." => sub { - my $out = `$perl -Ilib $bin_perlbrew help`; - like $out, qr/perlbrew help /si; - }; +subtest "`perlbrew help` should should the lengthy version " => sub { + my $out = `$perl -Ilib $bin_perlbrew help`; + like $out, qr/^CONFIGURATION$/m; }; -describe "`help install`" => sub { - it "should show the options for install command" => sub { - my $out = `$perl -Ilib $bin_perlbrew help install`; - like $out, qr/^Options for "install" command:/msi; - like $out, qr/--force/si; - like $out, qr/--notest/si; - }; +subtest "`perlbrew help` should instruct user to read help for individual commands." => sub { + my $out = `$perl -Ilib $bin_perlbrew help`; + like $out, qr/perlbrew help /si; }; -runtests unless caller; +subtest "`perlbrew help install` should show the options for install command" => sub { + my $out = `$perl -Ilib $bin_perlbrew help install`; + like $out, qr/^Options for "install" command:/msi; + like $out, qr/--force/si; + like $out, qr/--notest/si; +}; +done_testing; From 3a80783eeb6693fe7b561c1e4546020f56337db1 Mon Sep 17 00:00:00 2001 From: Kang-min Liu Date: Fri, 26 Jul 2024 07:39:38 +0900 Subject: [PATCH 3/4] [perlcritic] Test2::V0 implies stricture --- .perlcriticrc | 3 +++ 1 file changed, 3 insertions(+) diff --git a/.perlcriticrc b/.perlcriticrc index 3f65f7d8..145951d7 100644 --- a/.perlcriticrc +++ b/.perlcriticrc @@ -3,3 +3,6 @@ verbose = %f:%l:%c:[%p] %m => %r\n only = 1 include = RequireUseStrict ProhibitUnusedVariables ProhibitUnreachableCode ProhibitUnusedConstant ProhibitUnusedInclude ProhibitUnusedImport ProhibitDuplicateHashKeys ProhibitExcessiveColons ProhibitDuplicatedSub ProhibitTrailingWhitespace + +[TestingAndDebugging::RequireUseStrict] +equivalent_modules = Test2::V0 From 93f348b9f9f27b2a4d22110d3bf6b73a148e37ac Mon Sep 17 00:00:00 2001 From: Kang-min Liu Date: Fri, 26 Jul 2024 07:42:27 +0900 Subject: [PATCH 4/4] whitespace cleanup --- t/18.release-detail-perl-remote.t | 2 +- t/command-list.t | 10 +++++----- t/http-program-control.t | 2 +- 3 files changed, 7 insertions(+), 7 deletions(-) diff --git a/t/18.release-detail-perl-remote.t b/t/18.release-detail-perl-remote.t index 0b9b14fa..39ed957a 100644 --- a/t/18.release-detail-perl-remote.t +++ b/t/18.release-detail-perl-remote.t @@ -20,7 +20,7 @@ ok !$error, 'no error'; ok defined( $rd->{tarball_url} ), 'tarball_url is defined'; ok defined( $rd->{tarball_name} ), 'tarball_url is defined'; -is $rd->{tarball_url}, "https://www.cpan.org/src/5.0/perl-5.18.2.tar.bz2", +is $rd->{tarball_url}, "https://www.cpan.org/src/5.0/perl-5.18.2.tar.bz2", 'tarball_url is correct'; is $rd->{tarball_name}, "perl-5.18.2.tar.bz2", 'tarball_name is correct'; diff --git a/t/command-list.t b/t/command-list.t index a8359f59..da71eb3f 100644 --- a/t/command-list.t +++ b/t/command-list.t @@ -33,7 +33,7 @@ describe "list command," => sub { my $app = App::perlbrew->new("list"); my $events = intercept { $app->run() }; like $events, - [ + [ {info => [{tag => 'STDOUT', details => qr/^(\s|\*)\sc?perl-?\d\.\d{1,3}[_.]\d{1,2}\s+/}]} ], 'Cannot find Perl in output'; @@ -54,7 +54,7 @@ describe "list command," => sub { my $app = App::perlbrew->new("list"); my $events = intercept { $app->run() }; like $events, - [ + [ {info => [{tag => 'STDOUT', details => qr/^(\s|\*)\sc?perl-?\d\.\d{1,3}[_.]\d{1,2}(@\w+)?/}]} ], 'Cannot find Perl with libraries in output'; @@ -65,7 +65,7 @@ describe "list command," => sub { my $app = App::perlbrew->new("list"); my $events = intercept { $app->run() }; like $events, - [ + [ {info => [{tag => 'STDOUT', details => qr/^(\s|\*)\sc?perl-?\d\.\d{1,3}[_.]\d{1,2}(\@nobita)?/}]} ], 'Cannot find Perl with libraries in output'; @@ -79,7 +79,7 @@ describe "list command," => sub { $app->run(); }; like $events, - [ + [ {info => [{tag => 'STDOUT', details => qr/^perl-?\d\.\d{1,3}[_.]\d{1,2}(@\w+)?/}]} ], 'No decoration mark in the output'; @@ -91,7 +91,7 @@ describe "list command," => sub { my $app = App::perlbrew->new("list", "--no-decoration"); my $events = intercept { $app->run() }; like $events, - [ + [ {info => [{tag => 'STDOUT', details => qr/^perl-?\d\.\d{1,3}[_.]\d{1,2}(@\w+)?/}]} ], 'No decoration mark in the output'; diff --git a/t/http-program-control.t b/t/http-program-control.t index e198bd10..f7258138 100644 --- a/t/http-program-control.t +++ b/t/http-program-control.t @@ -25,7 +25,7 @@ for my $prog (qw(curl wget fetch)) { subtest "something not supported", sub { local $App::Perlbrew::HTTP::HTTP_USER_AGENT_PROGRAM = "something-that-is-not-recognized"; - ok dies { http_user_agent_program() }, + ok dies { http_user_agent_program() }, "should die when asked to use unrecognized http UA program"; };