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
146
147
148
|
#!perl -w
use strict;
use Test::More tests => 11;
use Data::Dumper;
use feature 'signatures';
no warnings 'experimental::signatures';
require Filter::signatures;
require B::Deparse;
# Eval code while still expanding it with source filters
sub compile {
my( $str ) = @_;
local $_ = $str;
Filter::signatures::transform_arguments();
return $_
};
sub normalize {
my( $str ) = @_;
my $compiled = eval $str;
die $@ if $@;
my $deparse = B::Deparse->new("-sC");
my $body = $deparse->coderef2text($compiled);
}
sub deparses_identical {
my( $str ) = @_;
my $transformed = normalize(compile($str));
my $native = normalize($str);
is $transformed, $native;
}
# Anonymous
$_ = <<'SUB';
sub ($name, $value) {
return "'$name' is '$value'"
};
SUB
deparses_identical( $_ );
Filter::signatures::transform_arguments();
is $_, <<'RESULT', "Anonymous subroutines get converted";
sub { my ($name,$value)=@_;
return "'$name' is '$value'"
};
RESULT
deparses_identical( $_ );
$_ = <<'SUB';
sub foo5 () {
return "We can call a sub without parameters"
};
SUB
Filter::signatures::transform_arguments();
is $_, <<'RESULT', "Parameterless subroutines don't get converted";
sub foo5 { @_==0 or warn "Subroutine foo5 called with parameters.";
return "We can call a sub without parameters"
};
RESULT
# Function default parameters
$_ = <<'SUB';
sub mylog($msg, $when=time) {
print "[$when] $msg\n";
};
SUB
Filter::signatures::transform_arguments();
is $_, <<'RESULT', "Function default parameters get converted";
sub mylog { my ($msg,$when)=@_;$when=time if @_ <= 1;
print "[$when] $msg\n";
};
RESULT
# Empty parameter list
$_ = <<'SUB';
sub mysub() {
print "Yey\n";
};
SUB
Filter::signatures::transform_arguments();
is $_, <<'RESULT', "Functions without parameters get converted properly";
sub mysub { @_==0 or warn "Subroutine mysub called with parameters.";
print "Yey\n";
};
RESULT
# Discarding parameters
$_ = <<'SUB';
sub mysub($) {
print "Yey\n";
};
SUB
Filter::signatures::transform_arguments();
is $_, <<'RESULT', "Functions with unnamed parameters get converted properly";
sub mysub { my (undef)=@_;
print "Yey\n";
};
RESULT
# Discarding parameters
$_ = <<'SUB';
sub mysub($foo, $, $bar) {
print "Yey, $foo => $bar\n";
};
SUB
Filter::signatures::transform_arguments();
is $_, <<'RESULT', "Functions without parameters get converted properly";
sub mysub { my ($foo,undef,$bar)=@_;
print "Yey, $foo => $bar\n";
};
RESULT
# Signature-less functions remain unchanged
$_ = <<'SUB';
sub mysub {
print "Yey\n";
};
SUB
Filter::signatures::transform_arguments();
is $_, <<'RESULT', "Named functions without signature remain unchanged";
sub mysub {
print "Yey\n";
};
RESULT
$_ = <<'SUB';
sub {
print "Yey\n";
};
SUB
Filter::signatures::transform_arguments();
is $_, <<'RESULT', "Named functions without signature remain unchanged";
sub {
print "Yey\n";
};
RESULT
$_ = <<'SUB';
sub foo($bar,$baz) { print "Yey\n"; }
SUB
Filter::signatures::transform_arguments();
is $_, <<'RESULT', "RT #xxxxxx Single-line functions work";
sub foo { my ($bar,$baz)=@_; print "Yey\n"; }
RESULT
done_testing;
|
