]> git.vpit.fr Git - perl/modules/indirect.git/blob - t/22-bad-mixed.t
Make sure asserts are only checked on DEBUGGING builds
[perl/modules/indirect.git] / t / 22-bad-mixed.t
1 #!perl -T
2
3 package NotEmpty;
4
5 sub new;
6
7 package main;
8
9 use strict;
10 use warnings;
11
12 use Test::More tests => 3 * 9;
13
14 BEGIN { delete $ENV{PERL_INDIRECT_PM_DISABLE} }
15
16 sub meh;
17
18 my @warns;
19
20 sub try {
21  my ($code) = @_;
22
23  @warns = ();
24  {
25   local $SIG{__WARN__} = sub { push @warns, @_ };
26   eval $code;
27  }
28 }
29
30 {
31  local $/ = "####";
32  while (<DATA>) {
33   chomp;
34   s/\s*$//;
35   s/(.*?)$//m;
36   my ($skip, $prefix) = split /#+/, $1;
37   $skip   = 0  unless defined $skip;
38   $prefix = '' unless defined $prefix;
39   s/\s*//;
40
41 SKIP:
42   {
43    skip "$_: $skip" => 9 if do { local $@; eval $skip };
44
45    {
46     local $_ = $_;
47     s/Pkg/Empty/g;
48
49     try "return; $prefix; use indirect; $_";
50     is $@,     '', "use indirect: $_";
51     is @warns, 0,  'correct number of reports';
52
53     try "return; $prefix; no indirect; $_";
54     is $@,     '', "no indirect: $_";
55     is @warns, 0,  'correct number of reports';
56    }
57
58    {
59     local $_ = $_;
60     s/Pkg/NotEmpty/g;
61
62     try "return; $prefix; use indirect; $_";
63     is $@,     '', "use indirect, defined: $_";
64     is @warns, 0,  'correct number of reports';
65
66     try "return; $prefix; no indirect; $_";
67     is $@,          '', "use indirect, defined: $_";
68     is @warns,      1,  'correct number of reports';
69     like $warns[0], qr/^Indirect call of method "meh" on object "NotEmpty" at \(eval \d+\) line \d+/, 'report 0 is correct';
70    }
71   }
72  }
73 }
74
75 __DATA__
76
77 meh Pkg->new;
78 ####
79 meh Pkg->new();
80 ####
81 meh Pkg->new, "Wut";