Server IP : 192.168.23.10 / Your IP : 52.14.158.115 Web Server : Apache System : Linux echo.premieradvertising.com 5.14.0-362.8.1.el9_3.x86_64 #1 SMP PREEMPT_DYNAMIC Tue Nov 7 14:54:22 EST 2023 x86_64 User : rrrallyteam ( 1049) PHP Version : 8.1.31 Disable Function : exec,passthru,shell_exec,system MySQL : OFF | cURL : ON | WGET : ON | Perl : ON | Python : OFF Directory (0755) : /sbin/../share/man/../doc/perl-Test-Simple/examples/ |
[ Home ] | [ C0mmand ] | [ Upload File ] |
---|
package Test2::Example; use Scalar::Util qw/blessed/; use Test2::Util qw/try/; use Test2 qw/context run_subtest/; use Test2::Hub::Interceptor(); use Test2::Hub::Interceptor::Terminator(); sub ok($;$@) { my ($bool, $name, @diag) = @_; my $ctx = context(); $ctx->ok($bool, $name, \@diag); $ctx->release; return $bool ? 1 : 0; } sub is($$;$@) { my ($got, $want, $name, @diag) = @_; my $ctx = context(); my $bool; if (defined($got) && defined($want)) { $bool = "$got" eq "$want"; } elsif (defined($got) xor defined($want)) { $bool = 0; } else { # Both are undef $bool = 1; } unless ($bool) { $got = '*NOT DEFINED*' unless defined $got; $want = '*NOT DEFINED*' unless defined $want; unshift @diag => ( "GOT: $got", "EXPECTED: $want", ); } $ctx->ok($bool, $name, \@diag); $ctx->release; return $bool; } sub isnt($$;$@) { my ($got, $want, $name, @diag) = @_; my $ctx = context(); my $bool; if (defined($got) && defined($want)) { $bool = "$got" ne "$want"; } elsif (defined($got) xor defined($want)) { $bool = 1; } else { # Both are undef $bool = 0; } unshift @diag => "Strings are the same (they should not be)" unless $bool; $ctx->ok($bool, $name, \@diag); $ctx->release; return $bool; } sub like($$;$@) { my ($thing, $pattern, $name, @diag) = @_; my $ctx = context(); my $bool; if (defined($thing)) { $bool = "$thing" =~ $pattern; unshift @diag => ( "Value: $thing", "Does not match: $pattern" ) unless $bool; } else { $bool = 0; unshift @diag => "Got an undefined value."; } $ctx->ok($bool, $name, \@diag); $ctx->release; return $bool; } sub unlike($$;$@) { my ($thing, $pattern, $name, @diag) = @_; my $ctx = context(); my $bool; if (defined($thing)) { $bool = "$thing" !~ $pattern; unshift @diag => ( "Unexpected pattern match (it should not match)", "Value: $thing", "Matches: $pattern" ) unless $bool; } else { $bool = 0; unshift @diag => "Got an undefined value."; } $ctx->ok($bool, $name, \@diag); $ctx->release; return $bool; } sub diag { my $ctx = context(); $ctx->diag( join '', @_ ); $ctx->release; } sub note { my $ctx = context(); $ctx->note( join '', @_ ); $ctx->release; } sub skip_all { my ($reason) = @_; my $ctx = context(); $ctx->plan(0, SKIP => $reason); $ctx->release if $ctx; } sub plan { my ($max) = @_; my $ctx = context(); $ctx->plan($max); $ctx->release; } sub done_testing { my $ctx = context(); $ctx->done_testing; $ctx->release; } sub subtest { my ($name, $code) = @_; my $ctx = context(); my $bool = run_subtest($name, $code, 1); $ctx->release; return $bool; } 1;