5c57ebed84a6a2b65e26ee44470402101e460b6b
[perl/modules/indirect.git] / t / 20-bad.t
1 #!perl -T
2
3 use strict;
4 use warnings;
5
6 use Test::More tests => 30 * 2 + 2;
7
8 my ($obj, $x);
9
10 {
11  local $/ = "####\n";
12  while (<DATA>) {
13   chomp;
14   {
15    use indirect;
16    local $SIG{__WARN__} = sub { die 'warn:' . join(' ', @_) };
17    eval "die qq{ok\\n}; $_";
18   }
19   is($@, "ok\n", $_);
20   {
21    no indirect;
22    local $SIG{__WARN__} = sub { die 'warn:' . join(' ', @_) };
23    eval "die qq{the code compiled but it shouldn't have\n}; $_";
24   }
25   like($@, qr/^warn:Indirect\s+call\s+of\s+method\s+"(?:new|meh|HlaghHlagh)"\s+on\s+object\s+"(?:Hlagh|newnew|\$x|\$_)"/, $_);
26  }
27 }
28
29 eval {
30  no indirect 'hlagh';
31  my $warn;
32  local $SIG{__WARN__} = sub { $warn = join ' ', @_ };
33  eval "die qq{the code compiled but it shouldn't have\n}; \$obj = new Hlagh1;";
34  like($warn, qr/^Indirect\s+call\s+of\s+method\s+"new"\s+on\s+object\s+"Hlagh1"/, 'no indirect "hlagh" enables the pragma');
35  eval "die qq{the code compiled but it shouldn't have\n}; \$obj = new Hlagh2;";
36  like($warn, qr/^Indirect\s+call\s+of\s+method\s+"new"\s+on\s+object\s+"Hlagh2"/, 'no indirect "hlagh" doesn\'t croak');
37 }
38
39 __DATA__
40 $obj = new Hlagh;
41 ####
42 $obj = new Hlagh();
43 ####
44 $obj = new Hlagh(1);
45 ####
46 $obj = new Hlagh(1, 2);
47 ####
48 $obj = new        Hlagh            ;
49 ####
50 $obj = new        Hlagh     (      )      ;
51 ####
52 $obj = new        Hlagh     (      1        )     ;
53 ####
54 $obj = new        Hlagh     (      1        ,       2        )     ;
55 ####
56 $obj = new    
57                       Hlagh             
58         ;
59 ####
60 $obj = new   
61                                        Hlagh     (    
62                   )      ;
63 ####
64 $obj =
65               new    
66     Hlagh     (      1   
67             )     ;
68 ####
69 $obj =
70 new      
71 Hlagh    
72                    (      1        ,  
73                 2        )     ;
74 ####
75 $obj = new $x;
76 ####
77 $obj = new $x();
78 ####
79 $obj = new $x('foo');
80 ####
81 $obj = new $x qq{foo}, 1;
82 ####
83 $obj = new $x qr{foo\s+bar}, 1 .. 1;
84 ####
85 $obj = new $x(qw/bar baz/);
86 ####
87 $obj = new
88           $_;
89 ####
90 $obj = new
91              $_     (        );
92 ####
93 $obj = new $_      qr/foo/  ;
94 ####
95 $obj = new $_     qq(bar baz);
96 ####
97 meh $x;
98 ####
99 meh $x, 1, 2;
100 ####
101 $obj = HlaghHlagh Hlagh;
102 ####
103 $obj = HlaghHlagh Hlagh; # HlaghHlagh Hlagh
104 ####
105 $obj = new newnew;
106 ####
107 $obj = new newnew; # new newnew
108 ####
109 new Hlagh (meh $x)
110 ####
111 Hlagh->new(meh $x)