File: TestScript.pm

package info (click to toggle)
libtest-needs-perl 0.002010-1
  • links: PTS, VCS
  • area: main
  • in suites: bookworm, forky, sid, trixie
  • size: 144 kB
  • sloc: perl: 551; makefile: 2
file content (91 lines) | stat: -rw-r--r-- 1,849 bytes parent folder | download | duplicates (3)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
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
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
package TestScript;
use strict;
use warnings;
use Test::Needs;

sub plan;
sub subtest;
sub done_testing;
sub ok;

for my $sub (qw(plan ok subtest done_testing)) {
  no strict 'refs';
  no warnings 'redefine';
  *$sub = sub {
    if (!$INC{'Test2/API.pm'}) {
      require Test::Builder;
      my $tb = Test::Builder->new;
      for my $install (qw(plan ok subtest done_testing)) {
        *{$install} = sub {
          $tb->$install(@_);
        };
      }
    }
    else {
      *plan = sub {
        my $ctx = Test2::API::context();
        $ctx->plan(
          $_[0] eq 'no_plan' ? (0, 'NO PLAN')
          : $_[0] eq 'tests' ? ($_[1])
          : @_
        );
        $ctx->release;
      };
      *subtest = \&Test2::API::run_subtest;
      *ok = sub {
        my $ctx = Test2::API::context();
        $ctx->ok(@_);
        $ctx->release;
      };
      *done_testing = sub {
        my $ctx = Test2::API::context();
        $ctx->done_testing;
        $ctx->release;
      };
    }
    goto &$sub;
  };
}

sub import {
  my $class = shift;
  my $opts = { map { /^--([^=]*)(?:=(.*))?/ ? ($1 => $2||1) : () } @_ };
  my @args = grep !/^--/, @_;
  @args = @args == 1 ? @args : { @args };
  if ($opts->{load}) {
    eval qq{ package main; use $opts->{load}; 1; } or die $@;
  }

  if ($opts->{subtest}) {
    plan tests => 1;
    subtest subtest => sub { do_test($opts, @args) };
  }
  else {
    do_test($opts, @args);
  }
  exit 0;
}


sub do_test {
  my ($opts, @args) = @_;
  if ($opts->{plan}) {
    plan tests => 2;
  }
  elsif ($opts->{no_plan}) {
    plan 'no_plan';
  }
  if ($opts->{tests}) {
    ok 1;
  }
  test_needs @args;
  plan tests => 2
    unless $opts->{tests} || $opts->{plan} || $opts->{no_plan};
  ok 1;
  ok 1
    unless $opts->{tests};
  done_testing
    if $opts->{tests} && !($opts->{plan} || $opts->{no_plan});
}

1;