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
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
|
use Test::More qw(no_plan);
use strict;
use B::PerlReq;
use PerlReq::Utils;
use Fcntl qw(F_SETFD);
sub spawn ($) {
my $code = shift;
open my $pipe, "-|", $^X, qw(-Mblib -MO=PerlReq -e) => $code
or return (undef, undef);
my $output = join '' => <$pipe>;
return (close($pipe), $output);
}
sub grok ($) {
my $code = shift;
fcntl(STDERR, F_SETFD, 1);
my ($ok, $output) = spawn($code);
if (not $ok) {
fcntl(STDERR, F_SETFD, 0);
spawn($code);
}
chomp $output;
return $output;
}
my $m = "Data::Dumper";
my $f = "Data/Dumper.pm";
my $d = "perl($f)";
my $m2 = "File::Basename";
my $f2 = "File/Basename.pm";
my $d2 = "perl($f2)";
my $m3 = "Tie::Hash";
my $f3 = "Tie/Hash.pm";
my $d3 = "perl($f3)";
cmp_ok $d, "eq", grok qq(use $m;);
cmp_ok $d, "eq", grok qq(require $m;);
cmp_ok $d, "eq", grok qq(require "$f";);
cmp_ok $d, "eq", grok qq(BEGIN { use $m; });
cmp_ok $d, "eq", grok qq(BEGIN { require $m; });
cmp_ok $d, "eq", grok qq(INIT { require "$f"; });
cmp_ok $d, "eq", grok qq(sub x { require $m; });
cmp_ok $d, "eq", grok qq(sub x { my \$x = sub { require $m; }});
cmp_ok $d, "eq", grok qq(my \$x = sub { require $m; });
cmp_ok $d, "eq", grok qq(my \$x = sub { my \$x = sub { require $m; }});
cmp_ok $d, "eq", grok qq(sub x { local *x = sub { require $m; }});
cmp_ok $d, "eq", grok qq(local *x = sub { require $m; });
cmp_ok $d, "eq", grok qq(local *x = sub { local *x = sub { require $m; }});
cmp_ok '', 'eq', grok qq(eval { require $m; };);
cmp_ok $d2, 'eq', grok qq(eval { require $m; }; require $m2; eval { require $m3 };);
cmp_ok $d2, 'eq', grok qq({eval { require $m; };} require $m2; {eval { require $m3 };});
cmp_ok $d2, 'eq', grok qq(my \$x = sub { eval { require $m; }; require $m2; };);
cmp_ok $d2, 'eq', grok qq(eval { eval { require $m; }; require $m; }; require $m2;);
cmp_ok $d2, 'eq', grok qq(eval { require $m; } || eval { require $m3; }; require $m2;);
cmp_ok $d2, 'eq', grok qq(require $m2; eval { $m2->VERSION(0.1); };);
cmp_ok "$d >= 2.0", 'eq', grok qq(use $m 2;);
cmp_ok "$d >= 2.0", 'eq', grok qq(use $m 2.0;);
cmp_ok "$d >= 2.0", 'eq', grok qq(use $m 2.00;);
cmp_ok "$d >= 2.0.998", 'eq', grok qq(use $m 2.000998;);
cmp_ok "$d >= 2.001", 'eq', grok qq(use $m 2.0009999;);
cmp_ok "$d >= 2.010", 'eq', grok qq(use $m 2.01;);
cmp_ok "$d >= 2.010", 'eq', grok qq(use $m 2.01 qw(Dumper););
cmp_ok "$d >= 2.010", 'eq', grok qq(use $m 2.01 qw(Dumper Dumper););
cmp_ok "$d >= 2.010", 'eq', grok qq(use $m 2.01, qw(Dumper););
cmp_ok "$d >= 2.010", 'eq', grok qq(use $m 2.01, qw(Dumper Dumper););
cmp_ok "$d >= 2.012", 'eq', grok qq(use $m 2.012;);
cmp_ok "$d >= 2.019.900", 'eq', grok qq(use $m 2.0199;);
cmp_ok "$d >= 2.0", 'eq', grok qq(use $m v2;);
cmp_ok "$d >= 2.0", 'eq', grok qq(use $m v2.0;);
cmp_ok "$d >= 2.0.998", 'eq', grok qq(use $m v2.0.998;);
cmp_ok "$d >= 2.0.999", 'eq', grok qq(use $m v2.0.999;);
cmp_ok "$d >= 2.001.001", 'eq', grok qq(use $m 2.1.1;);
cmp_ok "$d >= 2.001.001", 'eq', grok qq(use $m v2.1.1;);
cmp_ok "perl(base.pm)\n$d", 'eq', grok qq(use base qw($m););
cmp_ok "perl(base.pm) >= 1.0\n$d", 'eq', grok qq(use base 1 qw($m););
cmp_ok "perl(base.pm)\n$d\n$d2", 'eq', grok qq(use base qw($m $m2););
cmp_ok "$d3\nperl(base.pm)", 'eq', grok qq(use $m3; use base "Tie::StdHash";);
cmp_ok "perl(autouse.pm)\n$d", 'eq', grok qq(use autouse "$m";);
cmp_ok "perl(autouse.pm)\n$d", 'eq', grok qq(use autouse $m => qw(Dumper););
cmp_ok "perl(autouse.pm)\n$d", 'eq', grok qq(use autouse $m => qw(Dumper Dumper););
cmp_ok "perl(Try/Tiny.pm)\nperl(Bar.pm)", 'eq', grok q(use Try::Tiny; try { require Foo } catch { require Bar });
cmp_ok "perl(Try/Tiny.pm)\nperl(Bar.pm)", 'eq', grok q(use Try::Tiny; sub x { try { require Foo } catch { require Bar } });
cmp_ok "perl(Try/Tiny.pm)\nperl(Baz.pm)", 'eq', grok q(use Try::Tiny; try { try { require Foo } catch { require Bar } } catch { require Baz });
cmp_ok '', 'eq', grok qq( \$path="$f"; require \$path;);
cmp_ok '', 'eq', grok qq(my \$path="$f"; require \$path;);
cmp_ok '', 'eq', grok qq(require "./Data/Dumper.pm";);
cmp_ok "$d >= 2.0", 'eq', grok "require $m; $m->VERSION(2);";
cmp_ok "$d >= 2.0", 'eq', grok "require $m; $m->require_version(2);";
cmp_ok "perl(base.pm)\n$d", 'eq', grok "require base; base->import($m)";
cmp_ok "perl(base.pm) >= 1.0\n$d", 'eq', grok "require base; base->VERSION(1); base->import($m)";
cmp_ok "perl(base.pm)\n$d\nperl(base.pm) >= 1.0", 'eq', grok "require base; base->import($m); base->VERSION(1);";
cmp_ok "perl-base >= 1:5.10.0\n$d", 'eq', grok qq(require 5.010; *x = sub { require $m;};);
cmp_ok "$d\n$d2", "eq", grok qq(require $m; *x = sub { require $m2; };);
cmp_ok "$d\n$d2", "eq", grok qq(require $m; my \$x = sub { require $m2; };);
cmp_ok "perl(PerlIO.pm)\nperl(PerlIO/scalar.pm)", "eq", grok q(open FH, "<", \$ref);
cmp_ok "perl(PerlIO.pm)\nperl(PerlIO/scalar.pm)", "eq", grok q(open FH, "+<", \my $ref);
cmp_ok "perl(PerlIO.pm)\nperl(PerlIO/scalar.pm)", "eq", grok q(open my $fh, "<", \$ref);
cmp_ok "perl(PerlIO.pm)\nperl(PerlIO/scalar.pm)", "eq", grok q(open my $fh, "+>", \my $ref);
cmp_ok "perl(PerlIO.pm)\nperl(PerlIO/scalar.pm)", "eq", grok q(open my $fh, ">>", \my $ref);
cmp_ok "perl(PerlIO.pm)\nperl(PerlIO/encoding.pm)\nperl(Encode.pm)\nperl(Encode/Byte.pm)", "eq", grok q(open FH, "<:encoding(cp1251)", $0); # Byte
cmp_ok "perl(PerlIO.pm)\nperl(PerlIO/encoding.pm)\nperl(Encode.pm)\nperl(Encode/KR.pm)", "eq", grok q(binmode STDOUT, ":encoding(cp949)"); # KR
cmp_ok "perl(PerlIO.pm)\nperl(PerlIO/encoding.pm)\nperl(Encode.pm)\nperl(Encode/JP.pm)", "eq", grok q(open my $fh,">encoding(euc-jp)",$file); # JP
cmp_ok "perl(PerlIO.pm)\nperl(PerlIO/encoding.pm)\nperl(Encode.pm)", "eq", grok q(open $fh,"<encoding(US-ASCII)",$file);
cmp_ok "perl(PerlIO.pm)\nperl(PerlIO/via.pm)", "eq", grok q(open $fh,"<via(PerlIO::via::QuotedPrint)", $tmp);
cmp_ok "perl(PerlIO.pm)\nperl(PerlIO/via.pm)", "eq", grok q(open $fh,">via(PerlIO::via::QuotedPrint)", $tmp);
cmp_ok "", "eq", grok q(open FH, "<:encoding(cp1251)");
cmp_ok "", "eq", grok q(open FH, ">:encoding(cp1251)");
cmp_ok "perl(AnyDBM_File.pm)", "eq", grok q(dbmopen %db, "db.$$", 0600);
cmp_ok "perl(attributes.pm)", "eq", grok q(my $x : shared = 1);
cmp_ok "perl(File/Glob.pm)", "eq", grok q(<?>);
cmp_ok "", "eq", grok q(PerlIO::encoding->VERSION >= 0.02);
cmp_ok "perl(encoding.pm)\nperl(PerlIO/encoding.pm)\nperl(Encode/JP.pm)\nperl(Filter/Util/Call.pm)\nperl(utf8.pm)",
"eq", grok <<'EOF';
# from Encode/t/jperl.t
use encoding "euc-jp", Filter=>1;
use utf8;
our $ = 2;
EOF
cmp_ok "perl(Cwd.pm) >= 1.0", "eq", grok q(use Cwd 0==0);
# perl 5.22 sometimes optimizes to B::IV leading to crash
cmp_ok "$d", "eq", grok qq(sub foo{} foo; require $m;);
#END { $? = 0; }
|
