line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# |
2
|
|
|
|
|
|
|
# transform parsed PHP statements |
3
|
|
|
|
|
|
|
# |
4
|
|
|
|
|
|
|
package PHP::Decode::Transformer; |
5
|
|
|
|
|
|
|
|
6
|
4
|
|
|
4
|
|
140252
|
use strict; |
|
4
|
|
|
|
|
29
|
|
|
4
|
|
|
|
|
119
|
|
7
|
4
|
|
|
4
|
|
22
|
use warnings; |
|
4
|
|
|
|
|
11
|
|
|
4
|
|
|
|
|
105
|
|
8
|
4
|
|
|
4
|
|
19
|
use Carp 'croak'; |
|
4
|
|
|
|
|
8
|
|
|
4
|
|
|
|
|
186
|
|
9
|
4
|
|
|
4
|
|
896
|
use PHP::Decode::Array qw(is_int_index); |
|
4
|
|
|
|
|
9
|
|
|
4
|
|
|
|
|
197
|
|
10
|
4
|
|
|
4
|
|
1840
|
use PHP::Decode::Parser qw(:all); |
|
4
|
|
|
|
|
11
|
|
|
4
|
|
|
|
|
816
|
|
11
|
4
|
|
|
4
|
|
3399
|
use PHP::Decode::Func; |
|
4
|
|
|
|
|
19
|
|
|
4
|
|
|
|
|
343
|
|
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
our $VERSION = '0.301'; |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
# avoid 'Deep recursion' warnings for depth > 100 |
16
|
|
|
|
|
|
|
# |
17
|
4
|
|
|
4
|
|
26
|
no warnings 'recursion'; |
|
4
|
|
|
|
|
12
|
|
|
4
|
|
|
|
|
213601
|
|
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
# In php-5.3 old superglobal names were still available and mapped to new names: |
20
|
|
|
|
|
|
|
# $HTTP_SERVER_VARS $_SERVER |
21
|
|
|
|
|
|
|
# $HTTP_GET_VARS $_GET |
22
|
|
|
|
|
|
|
# $HTTP_POST_VARS $_POST |
23
|
|
|
|
|
|
|
# $HTTP_POST_FILES $_FILES |
24
|
|
|
|
|
|
|
# $HTTP_SESSION_VARS $_SESSION |
25
|
|
|
|
|
|
|
# $HTTP_ENV_VARS $_ENV |
26
|
|
|
|
|
|
|
# $HTTP_COOKIE_VARS $_COOKIE |
27
|
|
|
|
|
|
|
# |
28
|
|
|
|
|
|
|
my @superglobal_old = ('$HTTP_SERVER_VARS', '$HTTP_GET_VARS', '$HTTP_POST_VARS', '$HTTP_POST_FILES', '$HTTP_SESSION_VARS', '$HTTP_ENV_VARS', '$HTTP_COOKIE_VARS'); |
29
|
|
|
|
|
|
|
my %superglobal = map { $_ => 1 } ('$GLOBALS', '$_SERVER', '$_GET', '$_POST', '$_FILES', '$_COOKIE', '$_SESSION', '$_REQUEST', '$_ENV', @superglobal_old); |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
my $histidx = 0; |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
# Context: |
34
|
|
|
|
|
|
|
# - $ctx->{defines}: map of constants & user-defined values |
35
|
|
|
|
|
|
|
# - $ctx->{globals}: map of defined global & superglobal variables |
36
|
|
|
|
|
|
|
# - $ctx->{varmap}: map of defined local variables (points to $ctx->{globals} on toplevel) |
37
|
|
|
|
|
|
|
# - $ctx->{varmap}{global}: map of 'global $var' declarations in scope (renames $var to '$GLOBALS$var') |
38
|
|
|
|
|
|
|
# - $ctx->{varmap}{static}: map of 'static $var' declarations for functions & methods |
39
|
|
|
|
|
|
|
# - $ctx->{varmap}{ref}: map of $var = &$var2 references in scope |
40
|
|
|
|
|
|
|
# - $ctx->{varmap}{fun}: map of registered functions |
41
|
|
|
|
|
|
|
# - $ctx->{varmap}{class}: map of registered classes |
42
|
|
|
|
|
|
|
# - $ctx->{varmap}{inst}: map of #inst -> $var references in scope (renames obj->var to '$inst$var') |
43
|
|
|
|
|
|
|
# - $ctx->{varhist}: tracks variable assignments to insert on block level |
44
|
|
|
|
|
|
|
# - $ctx->{infunction}: function/method name if in function (lowercase) |
45
|
|
|
|
|
|
|
# - $ctx->{class_scope}: class name exists only if in classfunc/method-call (lowercase) |
46
|
|
|
|
|
|
|
# - $ctx->{namespace}: namespace or '' if default namespace |
47
|
|
|
|
|
|
|
# - $ctx->{incall}: in function/method calls (with resolved arguments) |
48
|
|
|
|
|
|
|
# - $ctx->{tainted}: incomplete variables in context |
49
|
|
|
|
|
|
|
# - $ctx->{skipundef}: skip conditions like empty($x) for undefined $x, so that no block is dropped |
50
|
|
|
|
|
|
|
# |
51
|
|
|
|
|
|
|
# Note: {static}{} & {inst}{} entries are always lowercase. |
52
|
|
|
|
|
|
|
# |
53
|
|
|
|
|
|
|
# supported {simplify} flags: {expr => 1, elem => 1, stmt => 1, call => 1, arr => 1} |
54
|
|
|
|
|
|
|
# supported {skip} flags: {call => 1, loop => 1, null => 1, stdout => 1, treat_empty_str_like_empty_array => 1} |
55
|
|
|
|
|
|
|
# supported {with} flags: {getenv => {}, optimize_block_vars => 1, invalidate_tainted_vars => 1, translate => 1} |
56
|
|
|
|
|
|
|
# |
57
|
|
|
|
|
|
|
sub new { |
58
|
1524
|
|
|
1524
|
1
|
8307
|
my ($class, %args) = @_; |
59
|
1524
|
|
|
|
|
2707
|
my %varmap; |
60
|
1524
|
50
|
|
|
|
3711
|
my $parser = $args{parser} or croak __PACKAGE__ . " expects parser"; |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
my $self = bless { |
63
|
|
|
|
|
|
|
toplevel => 1, # append STDOUT after eval |
64
|
|
|
|
|
|
|
defines => {}, |
65
|
|
|
|
|
|
|
globals => \%varmap, |
66
|
|
|
|
|
|
|
varmap => \%varmap, |
67
|
|
|
|
|
|
|
varhist => {}, |
68
|
|
|
|
|
|
|
infunction => 0, |
69
|
|
|
|
|
|
|
incall => 0, |
70
|
|
|
|
|
|
|
namespace => '', |
71
|
|
|
|
|
|
|
tainted => 0, |
72
|
|
|
|
|
|
|
skipundef => 0, |
73
|
|
|
|
|
|
|
max_loop => 10000, |
74
|
|
|
|
|
|
|
simplify => {expr => 1, elem => 1, stmt => 1, call => 1, arr => 1}, |
75
|
|
|
|
|
|
|
skip => {}, |
76
|
|
|
|
|
|
|
with => {}, |
77
|
|
|
|
0
|
|
|
warn => sub { }, |
78
|
1524
|
|
|
|
|
25782
|
superglobal => \%superglobal, |
79
|
|
|
|
|
|
|
%args, # might override preceding keys |
80
|
|
|
|
|
|
|
}, $class; |
81
|
|
|
|
|
|
|
|
82
|
1524
|
|
|
|
|
7117
|
$self->{max_loop_const} = $self->{max_loop}; |
83
|
1524
|
|
|
|
|
3024
|
$self->{max_loop_while} = 10 * $self->{max_loop}; |
84
|
1524
|
|
|
|
|
2816
|
$self->{max_repeat} = $self->{max_loop}; |
85
|
|
|
|
|
|
|
|
86
|
1524
|
100
|
|
|
|
4014
|
$self->{varmap}{inst} = {} unless exists $self->{varmap}{inst}; |
87
|
1524
|
100
|
|
|
|
3370
|
$self->{varmap}{fun} = {} unless exists $self->{varmap}{fun}; |
88
|
1524
|
100
|
|
|
|
3687
|
$self->{varmap}{class} = {} unless exists $self->{varmap}{class}; |
89
|
1524
|
100
|
|
|
|
3537
|
$self->{varmap}{static} = {} unless exists $self->{varmap}{static}; |
90
|
1524
|
100
|
|
|
|
4251
|
$self->{varmap}{stdout} = { buf => [] } unless exists $self->{varmap}{stdout}; |
91
|
|
|
|
|
|
|
|
92
|
1524
|
0
|
33
|
|
|
3425
|
$self->_setup_env($self->{with}{getenv}) if exists $self->{with}{getenv} && $self->{toplevel}; |
93
|
|
|
|
|
|
|
|
94
|
1524
|
|
|
|
|
5004
|
return $self; |
95
|
|
|
|
|
|
|
} |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
# The default is to reference the global and local varmaps from parent. |
98
|
|
|
|
|
|
|
# |
99
|
|
|
|
|
|
|
sub subctx { |
100
|
801
|
|
|
801
|
1
|
2940
|
my ($ctx, %args) = @_; |
101
|
|
|
|
|
|
|
|
102
|
801
|
100
|
|
|
|
2293
|
$args{globals} = $ctx->{globals} unless exists $args{globals}; |
103
|
801
|
100
|
|
|
|
1741
|
$args{varmap} = $ctx->{varmap} unless exists $args{varmap}; |
104
|
801
|
100
|
|
|
|
1876
|
$args{parser} = $ctx->{parser} unless exists $args{parser}; |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
my $ctx2 = PHP::Decode::Transformer->new( |
107
|
|
|
|
|
|
|
toplevel => 0, |
108
|
|
|
|
|
|
|
defines => $ctx->{defines}, |
109
|
|
|
|
|
|
|
infunction => $ctx->{infunction}, |
110
|
|
|
|
|
|
|
incall => $ctx->{incall}, |
111
|
|
|
|
|
|
|
namespace => $ctx->{namespace}, |
112
|
|
|
|
|
|
|
tainted => $ctx->{tainted}, |
113
|
|
|
|
|
|
|
skipundef => $ctx->{skipundef}, |
114
|
|
|
|
|
|
|
max_loop => $ctx->{max_loop}, |
115
|
|
|
|
|
|
|
simplify => $ctx->{simplify}, |
116
|
|
|
|
|
|
|
skip => $ctx->{skip}, |
117
|
|
|
|
|
|
|
with => $ctx->{with}, |
118
|
|
|
|
|
|
|
warn => $ctx->{warn}, |
119
|
|
|
|
|
|
|
exists $ctx->{log} ? (log => $ctx->{log}) : (), |
120
|
801
|
50
|
|
|
|
5268
|
exists $ctx->{class_scope} ? (class_scope => $ctx->{class_scope}) : (), |
|
|
100
|
|
|
|
|
|
121
|
|
|
|
|
|
|
%args); |
122
|
|
|
|
|
|
|
|
123
|
801
|
|
|
|
|
2631
|
return $ctx2; |
124
|
|
|
|
|
|
|
} |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
# Create a clone of current context with a shallow copy of varmap & globals map |
127
|
|
|
|
|
|
|
# |
128
|
|
|
|
|
|
|
# This is used for speculative execution when a if- or loop-condition could |
129
|
|
|
|
|
|
|
# not be resolved. |
130
|
|
|
|
|
|
|
# |
131
|
|
|
|
|
|
|
sub clone { |
132
|
172
|
|
|
172
|
0
|
332
|
my ($ctx) = @_; |
133
|
172
|
|
|
|
|
317
|
my %varmap = %{$ctx->{varmap}}; |
|
172
|
|
|
|
|
1616
|
|
134
|
172
|
100
|
|
|
|
603
|
my $globals = $ctx->{infunction} ? {%{$ctx->{globals}}} : \%varmap; |
|
64
|
|
|
|
|
245
|
|
135
|
|
|
|
|
|
|
|
136
|
172
|
|
|
|
|
626
|
return $ctx->subctx(globals => $globals, varmap => \%varmap, varhist => {}, skipundef => 1); |
137
|
|
|
|
|
|
|
} |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
# used for function simplifications |
140
|
|
|
|
|
|
|
# |
141
|
|
|
|
|
|
|
sub simplification_ctx { |
142
|
242
|
|
|
242
|
0
|
751
|
my ($ctx, %args) = @_; |
143
|
|
|
|
|
|
|
|
144
|
242
|
|
|
|
|
543
|
$args{globals} = {}; |
145
|
242
|
|
|
|
|
522
|
$args{varmap} = {}; |
146
|
242
|
|
|
|
|
535
|
$args{varhist} = {}; |
147
|
242
|
|
|
|
|
434
|
$args{skipundef} = 1; # skip undefined variables |
148
|
242
|
|
|
|
|
412
|
$args{tainted} = 1; # don't assume #null for undefined vars |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
# allow to reference global functions and classes, when |
151
|
|
|
|
|
|
|
# a function or class is simplified. |
152
|
|
|
|
|
|
|
# |
153
|
|
|
|
|
|
|
# create shallow copies, so that no new functions are |
154
|
|
|
|
|
|
|
# created for parent ctx. |
155
|
|
|
|
|
|
|
# |
156
|
242
|
100
|
|
|
|
578
|
if (exists $ctx->{globals}{fun}) { |
157
|
232
|
50
|
|
|
|
471
|
if (exists $ctx->{varmap}{fun}) { |
158
|
232
|
|
|
|
|
396
|
$args{globals}{fun} = {%{$ctx->{globals}{fun}}, %{$ctx->{varmap}{fun}}}; |
|
232
|
|
|
|
|
697
|
|
|
232
|
|
|
|
|
864
|
|
159
|
|
|
|
|
|
|
} else { |
160
|
0
|
|
|
|
|
0
|
$args{globals}{fun} = {%{$ctx->{globals}{fun}}}; |
|
0
|
|
|
|
|
0
|
|
161
|
|
|
|
|
|
|
} |
162
|
|
|
|
|
|
|
} |
163
|
242
|
100
|
|
|
|
665
|
if (exists $ctx->{globals}{class}) { |
164
|
229
|
50
|
|
|
|
470
|
if (exists $ctx->{varmap}{class}) { |
165
|
229
|
|
|
|
|
318
|
$args{globals}{class} = {%{$ctx->{globals}{class}}, %{$ctx->{varmap}{class}}}; |
|
229
|
|
|
|
|
505
|
|
|
229
|
|
|
|
|
587
|
|
166
|
|
|
|
|
|
|
} else { |
167
|
0
|
|
|
|
|
0
|
$args{globals}{class} = {%{$ctx->{globals}{class}}}; |
|
0
|
|
|
|
|
0
|
|
168
|
|
|
|
|
|
|
} |
169
|
|
|
|
|
|
|
} |
170
|
|
|
|
|
|
|
# keep global statements active when functions are simplified |
171
|
|
|
|
|
|
|
# |
172
|
242
|
100
|
|
|
|
636
|
if (exists $ctx->{varmap}{global}) { |
173
|
8
|
|
|
|
|
23
|
$args{varmap}{global} = {%{$ctx->{varmap}{global}}}; |
|
8
|
|
|
|
|
22
|
|
174
|
|
|
|
|
|
|
} |
175
|
242
|
|
|
|
|
826
|
return $ctx->subctx(%args); |
176
|
|
|
|
|
|
|
} |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
# used for function calls (local vars can be used even if caller is tainted) |
179
|
|
|
|
|
|
|
# |
180
|
|
|
|
|
|
|
sub subscope_ctx { |
181
|
272
|
|
|
272
|
0
|
1063
|
my ($ctx, %args) = @_; |
182
|
272
|
50
|
|
|
|
719
|
my $varmap = $args{varmap} or croak __PACKAGE__ . " expects varmap"; |
183
|
|
|
|
|
|
|
|
184
|
272
|
|
|
|
|
511
|
$args{parent} = $ctx; # keep reference to parent scope |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
# copy globals and pass new varmap |
187
|
|
|
|
|
|
|
# add instance var context to local varmap. |
188
|
|
|
|
|
|
|
# |
189
|
272
|
100
|
|
|
|
634
|
if (exists $ctx->{varmap}{'$this'}) { |
190
|
1
|
|
|
|
|
9
|
$args{varmap}{'$this'} = $ctx->{varmap}{'$this'}; |
191
|
|
|
|
|
|
|
} |
192
|
272
|
50
|
|
|
|
576
|
if (exists $ctx->{varmap}{inst}) { |
193
|
272
|
|
|
|
|
562
|
$args{varmap}{inst} = $ctx->{varmap}{inst}; |
194
|
|
|
|
|
|
|
} |
195
|
272
|
50
|
|
|
|
563
|
if (exists $ctx->{varmap}{fun}) { |
196
|
272
|
|
|
|
|
523
|
$args{varmap}{fun} = $ctx->{varmap}{fun}; |
197
|
|
|
|
|
|
|
} |
198
|
272
|
50
|
|
|
|
687
|
if (exists $ctx->{varmap}{class}) { |
199
|
272
|
|
|
|
|
519
|
$args{varmap}{class} = $ctx->{varmap}{class}; |
200
|
|
|
|
|
|
|
} |
201
|
272
|
50
|
|
|
|
568
|
if (exists $ctx->{varmap}{static}) { |
202
|
272
|
|
|
|
|
477
|
$args{varmap}{static} = $ctx->{varmap}{static}; |
203
|
|
|
|
|
|
|
} |
204
|
272
|
|
|
|
|
940
|
return $ctx->subctx(%args); |
205
|
|
|
|
|
|
|
} |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
sub _setup_env { |
208
|
0
|
|
|
0
|
|
0
|
my ($ctx, $env) = @_; |
209
|
0
|
|
|
|
|
0
|
my $parser = $ctx->{parser}; |
210
|
0
|
|
|
|
|
0
|
my $arr = $parser->newarr(); |
211
|
|
|
|
|
|
|
|
212
|
0
|
|
|
|
|
0
|
foreach my $key (keys %$env) { |
213
|
0
|
|
|
|
|
0
|
my $k = $parser->setstr($key); |
214
|
0
|
|
|
|
|
0
|
my $v = $parser->setstr($env->{$key}); |
215
|
0
|
|
|
|
|
0
|
$arr->set($k, $v); |
216
|
|
|
|
|
|
|
} |
217
|
0
|
|
|
|
|
0
|
$ctx->{globals}{'$_ENV'} = $arr->{name}; |
218
|
0
|
|
|
|
|
0
|
my $arr2 = $arr->copy(); |
219
|
0
|
|
|
|
|
0
|
$ctx->{globals}{'$_SERVER'} = $arr2->{name}; |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
# superglobal arrays are currently created on the fly |
222
|
|
|
|
|
|
|
# |
223
|
0
|
|
|
|
|
0
|
if (0) { |
224
|
|
|
|
|
|
|
foreach my $var (keys %{$ctx->{superglobal}}) { |
225
|
|
|
|
|
|
|
unless (exists ($ctx->{globals}{$var})) { |
226
|
|
|
|
|
|
|
$arr = $parser->newarr(); |
227
|
|
|
|
|
|
|
$ctx->{globals}{$var} = $arr->{name}; |
228
|
|
|
|
|
|
|
} |
229
|
|
|
|
|
|
|
} |
230
|
|
|
|
|
|
|
} |
231
|
|
|
|
|
|
|
} |
232
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
sub cmd_getenv { |
234
|
0
|
|
|
0
|
0
|
0
|
my ($ctx, $cmd, $args) = @_; |
235
|
0
|
|
|
|
|
0
|
my $parser = $ctx->{parser}; |
236
|
|
|
|
|
|
|
|
237
|
0
|
0
|
0
|
|
|
0
|
if (exists $ctx->{with}{getenv} && (scalar @$args == 1)) { |
238
|
0
|
|
|
|
|
0
|
my $s = $parser->get_strval($$args[0]); |
239
|
0
|
0
|
|
|
|
0
|
if (defined $s) { |
240
|
|
|
|
|
|
|
# on some platforms getenv is case-independant, $_ENV/$_SERVER is not |
241
|
|
|
|
|
|
|
# https://php.net/manual/en/function.getenv.php |
242
|
|
|
|
|
|
|
# |
243
|
0
|
0
|
|
|
|
0
|
if (exists $ctx->{globals}{'$_ENV'}) { |
244
|
0
|
|
|
|
|
0
|
my $arr = $parser->{strmap}{$ctx->{globals}{'$_ENV'}}; |
245
|
0
|
|
|
|
|
0
|
my $idxstr = $$args[0]; |
246
|
0
|
0
|
|
|
|
0
|
if ($s ne uc($s)) { |
247
|
0
|
|
|
|
|
0
|
$idxstr = $parser->setstr(uc($s)); |
248
|
|
|
|
|
|
|
} |
249
|
0
|
|
|
|
|
0
|
my $arrval = $arr->get($idxstr); |
250
|
0
|
0
|
|
|
|
0
|
if (defined $arrval) { |
251
|
0
|
|
|
|
|
0
|
return $arrval; |
252
|
|
|
|
|
|
|
} |
253
|
|
|
|
|
|
|
} |
254
|
0
|
|
|
|
|
0
|
return $parser->setstr(''); |
255
|
|
|
|
|
|
|
} |
256
|
|
|
|
|
|
|
} |
257
|
0
|
|
|
|
|
0
|
return; |
258
|
|
|
|
|
|
|
} |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
sub cmd_ob_start { |
261
|
1
|
|
|
1
|
0
|
4
|
my ($ctx, $cmd, $args) = @_; |
262
|
1
|
|
|
|
|
4
|
my $parser = $ctx->{parser}; |
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
# https://php.net/manual/en/function.ob-start.php |
265
|
|
|
|
|
|
|
# buffer output until ob_end_flush()/ob_end_clean() is called. |
266
|
|
|
|
|
|
|
# read output buffer via ob_get_contents(). |
267
|
|
|
|
|
|
|
# |
268
|
|
|
|
|
|
|
# TODO: ob_start stacking |
269
|
|
|
|
|
|
|
# |
270
|
1
|
50
|
|
|
|
5
|
if (scalar @$args >= 1) { |
271
|
|
|
|
|
|
|
# string handler ( string $buffer [, int $phase ] ) |
272
|
|
|
|
|
|
|
# |
273
|
1
|
|
|
|
|
4
|
my $handler = $$args[0]; |
274
|
1
|
|
|
|
|
6
|
my $name = $parser->get_strval($$args[0]); |
275
|
1
|
50
|
33
|
|
|
13
|
if (exists $ctx->{globals} && exists $ctx->{globals}{stdout} && defined $name) { |
|
|
|
33
|
|
|
|
|
276
|
1
|
50
|
|
|
|
4
|
unless ($ctx->{infunction}) { |
277
|
1
|
50
|
|
|
|
4
|
$ctx->{log}->($ctx, 'cmd', $cmd, "(handler: $name)") if $ctx->{log}; |
278
|
|
|
|
|
|
|
|
279
|
1
|
|
|
|
|
4
|
my $fun = $ctx->getfun($name); |
280
|
1
|
50
|
|
|
|
16
|
if (defined $fun) { |
281
|
1
|
|
|
|
|
3
|
my ($_name, $a, $b, $p) = @{$parser->{strmap}->{$fun}}; |
|
1
|
|
|
|
|
7
|
|
282
|
1
|
|
|
|
|
7
|
my $f = $parser->setfun(undef, $a, $b); |
283
|
1
|
|
|
|
|
6
|
my $v = '$ob_'.$name; |
284
|
1
|
|
|
|
|
6
|
$ctx->{globals}{stdout}{handler} = $v; # handler variable |
285
|
1
|
|
|
|
|
3
|
$ctx->{globals}{stdout}{ob} = []; |
286
|
|
|
|
|
|
|
|
287
|
|
|
|
|
|
|
# note: returns handler assignment instead of bool here |
288
|
|
|
|
|
|
|
# |
289
|
1
|
|
|
|
|
5
|
my $e = $parser->setexpr('=', $v, $f); |
290
|
|
|
|
|
|
|
#my $e = $parser->setcall('ob_start', [$f]); |
291
|
1
|
|
|
|
|
8
|
return $e; |
292
|
|
|
|
|
|
|
#return $parser->setnum(1); |
293
|
|
|
|
|
|
|
} else { |
294
|
0
|
|
|
|
|
0
|
return $parser->setnum(0); |
295
|
|
|
|
|
|
|
} |
296
|
|
|
|
|
|
|
} |
297
|
|
|
|
|
|
|
} |
298
|
|
|
|
|
|
|
} else { |
299
|
0
|
0
|
0
|
|
|
0
|
if (exists $ctx->{globals} && exists $ctx->{globals}{stdout}) { |
300
|
0
|
0
|
|
|
|
0
|
unless ($ctx->{infunction}) { |
301
|
0
|
0
|
|
|
|
0
|
$ctx->{log}->($ctx, 'cmd', $cmd, "()") if $ctx->{log}; |
302
|
0
|
|
|
|
|
0
|
$ctx->{globals}{stdout}{handler} = '#null'; |
303
|
0
|
|
|
|
|
0
|
$ctx->{globals}{stdout}{ob} = []; |
304
|
0
|
|
|
|
|
0
|
return $parser->setnum(1); |
305
|
|
|
|
|
|
|
} |
306
|
|
|
|
|
|
|
} |
307
|
|
|
|
|
|
|
} |
308
|
0
|
|
|
|
|
0
|
return; |
309
|
|
|
|
|
|
|
} |
310
|
|
|
|
|
|
|
|
311
|
|
|
|
|
|
|
sub cmd_ob_end_flush { |
312
|
1
|
|
|
1
|
0
|
10
|
my ($ctx, $cmd, $args) = @_; |
313
|
1
|
|
|
|
|
4
|
my $parser = $ctx->{parser}; |
314
|
|
|
|
|
|
|
|
315
|
1
|
50
|
33
|
|
|
9
|
if (exists $ctx->{globals} && exists $ctx->{globals}{stdout}) { |
316
|
1
|
50
|
|
|
|
6
|
if (exists $ctx->{globals}{stdout}{handler}) { |
317
|
1
|
50
|
|
|
|
4
|
unless ($ctx->{infunction}) { |
318
|
1
|
|
|
|
|
5
|
my @r; |
319
|
1
|
|
|
|
|
5
|
my $handler = $ctx->{globals}{stdout}{handler}; |
320
|
1
|
|
|
|
|
4
|
my @ob = @{$ctx->{globals}{stdout}{ob}}; |
|
1
|
|
|
|
|
4
|
|
321
|
1
|
|
|
|
|
3
|
delete $ctx->{globals}{stdout}{handler}; |
322
|
1
|
|
|
|
|
4
|
delete $ctx->{globals}{stdout}{ob}; |
323
|
1
|
50
|
|
|
|
5
|
$ctx->{log}->($ctx, 'cmd', $cmd, "(handler: $handler) [%s]", join(' ', @ob)) if $ctx->{log}; |
324
|
1
|
|
|
|
|
6
|
merge_str_list(\@ob, $parser); |
325
|
1
|
|
|
|
|
6
|
while (my $s = shift @ob) { |
326
|
1
|
50
|
33
|
|
|
3
|
if (is_strval($s) && ($handler ne '#null')) { |
327
|
1
|
|
|
|
|
7
|
my $h = $parser->setcall($handler, [$s]); |
328
|
1
|
|
|
|
|
6
|
my $k = $ctx->exec_statement($h); |
329
|
|
|
|
|
|
|
|
330
|
1
|
50
|
|
|
|
11
|
if (defined $k) { |
331
|
1
|
|
|
|
|
8
|
push(@r, $h); |
332
|
|
|
|
|
|
|
} |
333
|
|
|
|
|
|
|
} else { |
334
|
0
|
|
|
|
|
0
|
push(@{$ctx->{globals}{stdout}{buf}}, $s); |
|
0
|
|
|
|
|
0
|
|
335
|
|
|
|
|
|
|
} |
336
|
|
|
|
|
|
|
} |
337
|
1
|
50
|
|
|
|
5
|
if (@r) { |
338
|
|
|
|
|
|
|
# note: returns handler call instead of bool here |
339
|
|
|
|
|
|
|
# |
340
|
1
|
|
|
|
|
6
|
return _flat_block_or_single($parser, \@r); |
341
|
|
|
|
|
|
|
} |
342
|
0
|
|
|
|
|
0
|
return $parser->setnum(1); |
343
|
|
|
|
|
|
|
} |
344
|
|
|
|
|
|
|
} else { |
345
|
0
|
0
|
|
|
|
0
|
unless ($ctx->{infunction}) { |
346
|
0
|
|
|
|
|
0
|
return $parser->setnum(0); |
347
|
|
|
|
|
|
|
} |
348
|
|
|
|
|
|
|
} |
349
|
|
|
|
|
|
|
} |
350
|
0
|
|
|
|
|
0
|
return; |
351
|
|
|
|
|
|
|
} |
352
|
|
|
|
|
|
|
|
353
|
|
|
|
|
|
|
sub cmd_ob_end_clean { |
354
|
0
|
|
|
0
|
0
|
0
|
my ($ctx, $cmd, $args) = @_; |
355
|
0
|
|
|
|
|
0
|
my $parser = $ctx->{parser}; |
356
|
|
|
|
|
|
|
|
357
|
0
|
0
|
0
|
|
|
0
|
if (exists $ctx->{globals} && exists $ctx->{globals}{stdout}) { |
358
|
0
|
0
|
|
|
|
0
|
if (exists $ctx->{globals}{stdout}{handler}) { |
359
|
0
|
0
|
|
|
|
0
|
unless ($ctx->{infunction}) { |
360
|
0
|
|
|
|
|
0
|
delete $ctx->{globals}{stdout}{handler}; |
361
|
0
|
|
|
|
|
0
|
delete $ctx->{globals}{stdout}{ob}; |
362
|
0
|
|
|
|
|
0
|
return $parser->setnum(1); |
363
|
|
|
|
|
|
|
} |
364
|
|
|
|
|
|
|
} else { |
365
|
0
|
0
|
|
|
|
0
|
unless ($ctx->{infunction}) { |
366
|
0
|
|
|
|
|
0
|
return $parser->setnum(0); |
367
|
|
|
|
|
|
|
} |
368
|
|
|
|
|
|
|
} |
369
|
|
|
|
|
|
|
} |
370
|
0
|
|
|
|
|
0
|
return; |
371
|
|
|
|
|
|
|
} |
372
|
|
|
|
|
|
|
|
373
|
|
|
|
|
|
|
|
374
|
|
|
|
|
|
|
sub register_funcs { |
375
|
1013
|
|
|
1013
|
0
|
1748
|
my ($list, $ctx, $parser) = @_; |
376
|
|
|
|
|
|
|
|
377
|
1013
|
|
|
|
|
2053
|
foreach my $k (@$list) { |
378
|
1536
|
100
|
100
|
|
|
6347
|
if (($k =~ /^#stmt\d+$/) && ($parser->{strmap}{$k}[0] eq 'namespace')) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
379
|
10
|
|
|
|
|
22
|
my ($arg, $block) = @{$parser->{strmap}->{$k}}[1..2]; |
|
10
|
|
|
|
|
32
|
|
380
|
10
|
|
|
|
|
26
|
$ctx->{namespace} = $arg; # always use case in-sensitive later |
381
|
|
|
|
|
|
|
} elsif ($k =~ /^#fun\d+$/) { |
382
|
175
|
|
|
|
|
288
|
my ($f, $a, $b, $p) = @{$parser->{strmap}->{$k}}; |
|
175
|
|
|
|
|
524
|
|
383
|
175
|
100
|
|
|
|
469
|
if (defined $f) { |
384
|
164
|
|
|
|
|
396
|
$ctx->registerfun($f, $k); |
385
|
|
|
|
|
|
|
} |
386
|
|
|
|
|
|
|
} elsif ($k =~ /^#class\d+$/) { |
387
|
53
|
|
|
|
|
82
|
my ($c, $b, $p) = @{$parser->{strmap}->{$k}}; |
|
53
|
|
|
|
|
159
|
|
388
|
53
|
|
|
|
|
76
|
my ($type, $arglist) = @{$parser->{strmap}->{$b}}; |
|
53
|
|
|
|
|
119
|
|
389
|
|
|
|
|
|
|
|
390
|
53
|
|
|
|
|
127
|
foreach my $a (@$arglist) { |
391
|
89
|
100
|
|
|
|
227
|
if ($a =~ /^#fun\d+$/) { |
392
|
45
|
|
|
|
|
102
|
my $f = $parser->{strmap}->{$a}->[0]; |
393
|
45
|
50
|
|
|
|
103
|
if (defined $f) { |
394
|
45
|
50
|
|
|
|
93
|
my $name = defined $c ? $c : 'class@anonymous'; |
395
|
45
|
|
|
|
|
138
|
my $ctx2 = $ctx->subctx(class_scope => lc($name), infunction => 0); |
396
|
45
|
|
|
|
|
146
|
$ctx2->registerfun($f, $a); |
397
|
|
|
|
|
|
|
} |
398
|
|
|
|
|
|
|
} |
399
|
|
|
|
|
|
|
} |
400
|
53
|
50
|
|
|
|
149
|
if (defined $c) { |
401
|
53
|
|
|
|
|
119
|
$ctx->registerclass($c, $k); |
402
|
|
|
|
|
|
|
} |
403
|
|
|
|
|
|
|
} |
404
|
|
|
|
|
|
|
} |
405
|
1013
|
|
|
|
|
1752
|
return; |
406
|
|
|
|
|
|
|
} |
407
|
|
|
|
|
|
|
|
408
|
|
|
|
|
|
|
sub _move_funcs_to_start { |
409
|
784
|
|
|
784
|
|
1355
|
my ($parser, $stmt) = @_; |
410
|
784
|
|
|
|
|
1114
|
my @funcs = (); |
411
|
784
|
|
|
|
|
1031
|
my @code = (); |
412
|
784
|
|
|
|
|
1068
|
my @block = (); |
413
|
|
|
|
|
|
|
|
414
|
784
|
100
|
|
|
|
1960
|
if (is_block($stmt)) { |
415
|
457
|
|
|
|
|
648
|
my ($type, $a) = @{$parser->{strmap}{$stmt}}; |
|
457
|
|
|
|
|
1181
|
|
416
|
|
|
|
|
|
|
|
417
|
457
|
|
|
|
|
1002
|
foreach my $k (@$a) { |
418
|
1090
|
100
|
100
|
|
|
4185
|
if (($k =~ /^#stmt\d+$/) && ($parser->{strmap}{$k}[0] eq 'namespace')) { |
|
|
100
|
|
|
|
|
|
419
|
10
|
|
|
|
|
17
|
push(@block, @funcs); |
420
|
10
|
|
|
|
|
16
|
push(@block, @code); |
421
|
10
|
|
|
|
|
20
|
push(@block, $k); |
422
|
10
|
|
|
|
|
14
|
@funcs = (); |
423
|
10
|
|
|
|
|
16
|
@code = (); |
424
|
|
|
|
|
|
|
} elsif ($k =~ /^#(fun|class)\d+$/) { |
425
|
184
|
|
|
|
|
436
|
push(@funcs, $k); |
426
|
|
|
|
|
|
|
} else { |
427
|
896
|
|
|
|
|
1725
|
push(@code, $k); |
428
|
|
|
|
|
|
|
} |
429
|
|
|
|
|
|
|
} |
430
|
457
|
|
|
|
|
738
|
push(@block, @funcs); |
431
|
457
|
|
|
|
|
791
|
push(@block, @code); |
432
|
457
|
100
|
|
|
|
1004
|
if (scalar @block == 1) { |
433
|
1
|
|
|
|
|
4
|
return $block[0]; |
434
|
|
|
|
|
|
|
} |
435
|
456
|
|
|
|
|
1476
|
my $s = $parser->setblk('flat', [@block]); |
436
|
456
|
|
|
|
|
1214
|
return $s; |
437
|
|
|
|
|
|
|
} |
438
|
327
|
|
|
|
|
770
|
return $stmt; |
439
|
|
|
|
|
|
|
} |
440
|
|
|
|
|
|
|
|
441
|
|
|
|
|
|
|
sub parse_eval { |
442
|
792
|
|
|
792
|
1
|
1611
|
my ($ctx, $arg) = @_; |
443
|
792
|
|
|
|
|
1385
|
my $parser = $ctx->{parser}; |
444
|
|
|
|
|
|
|
|
445
|
792
|
|
|
|
|
2214
|
my $s = $parser->get_strval($arg); |
446
|
792
|
100
|
|
|
|
1987
|
if (defined $s) { |
447
|
784
|
50
|
|
|
|
1727
|
$ctx->{log}->($ctx, 'eval', $arg, "%s", $parser->shortstr($s, 400)) if $ctx->{log}; |
448
|
|
|
|
|
|
|
|
449
|
784
|
100
|
|
|
|
2264
|
$parser->{strmap}->{'__FILE__'} = $s if $ctx->{toplevel}; # for fopen('__FILE__') |
450
|
|
|
|
|
|
|
|
451
|
|
|
|
|
|
|
# (1) tokenize input file |
452
|
|
|
|
|
|
|
# |
453
|
784
|
|
|
|
|
3162
|
my $quote = $parser->tokenize_line($s, $ctx->{quote}); |
454
|
784
|
50
|
|
|
|
1962
|
if (defined $quote) { |
455
|
|
|
|
|
|
|
# some lines are cut at the end |
456
|
0
|
|
|
|
|
0
|
$ctx->{warn}->($ctx, 'eval', $arg, "tokenize bad quote %s, line: [%s]", $quote, $parser->shortstr($s, 200)); |
457
|
|
|
|
|
|
|
} |
458
|
784
|
|
|
|
|
1297
|
my $tok = $parser->{tok}; |
459
|
|
|
|
|
|
|
|
460
|
|
|
|
|
|
|
#$ctx->{log}->($ctx, 'eval', $arg, "tokens: %s", $parser->shortstr(join(' ', @$tok), 200)) if $ctx->{log}; |
461
|
784
|
50
|
|
|
|
1597
|
$ctx->{log}->($ctx, 'eval', $arg, "tokens: %s", join(' ', @$tok)) if $ctx->{log}; |
462
|
|
|
|
|
|
|
|
463
|
|
|
|
|
|
|
# (2) parse tokens to statements |
464
|
|
|
|
|
|
|
# |
465
|
784
|
|
|
|
|
2051
|
my $out = $parser->read_code($tok); |
466
|
|
|
|
|
|
|
|
467
|
784
|
50
|
|
|
|
1866
|
if ($parser->{debug}) { |
468
|
0
|
|
|
|
|
0
|
my $line = $parser->format_stmt($out, {format => 1}); |
469
|
0
|
0
|
|
|
|
0
|
$parser->{debug}->('eval', "$arg: parsed line: %s", $line) if $parser->{debug}; |
470
|
|
|
|
|
|
|
} |
471
|
784
|
|
|
|
|
2563
|
return $out; # empty block if token list is empty |
472
|
|
|
|
|
|
|
} |
473
|
8
|
|
|
|
|
31
|
return; |
474
|
|
|
|
|
|
|
} |
475
|
|
|
|
|
|
|
|
476
|
|
|
|
|
|
|
sub exec_eval { |
477
|
784
|
|
|
784
|
1
|
2185
|
my ($ctx, $arg) = @_; |
478
|
784
|
|
|
|
|
1348
|
my $parser = $ctx->{parser}; |
479
|
|
|
|
|
|
|
|
480
|
784
|
50
|
|
|
|
1640
|
if (defined $arg) { |
|
|
0
|
|
|
|
|
|
481
|
784
|
|
|
|
|
1274
|
my @funcs = (); |
482
|
784
|
|
|
|
|
1240
|
my @code = (); |
483
|
|
|
|
|
|
|
|
484
|
784
|
|
|
|
|
1454
|
$ctx->{tainted} = 0; |
485
|
|
|
|
|
|
|
|
486
|
|
|
|
|
|
|
# rearrange tokens |
487
|
|
|
|
|
|
|
# |
488
|
784
|
|
|
|
|
1563
|
my $out = _move_funcs_to_start($parser, $arg); |
489
|
784
|
100
|
|
|
|
1711
|
if (is_block($out)) { |
490
|
456
|
|
|
|
|
656
|
my ($type, $a) = @{$parser->{strmap}->{$out}}; |
|
456
|
|
|
|
|
1030
|
|
491
|
456
|
|
|
|
|
1219
|
@funcs = @$a; |
492
|
|
|
|
|
|
|
} else { |
493
|
328
|
|
|
|
|
686
|
@funcs = ($out); |
494
|
|
|
|
|
|
|
} |
495
|
|
|
|
|
|
|
|
496
|
|
|
|
|
|
|
# (3) exec statements |
497
|
|
|
|
|
|
|
# |
498
|
784
|
|
|
|
|
2216
|
register_funcs(\@funcs, $ctx, $parser); |
499
|
784
|
50
|
|
|
|
1733
|
$ctx->{log}->($ctx, 'eval', $arg, "parsed: $out") if $ctx->{log}; |
500
|
784
|
100
|
|
|
|
1620
|
my $in_block = is_block($out) ? 0 : 1; |
501
|
784
|
|
|
|
|
2098
|
my $stmt = $ctx->exec_statement($out, $in_block); |
502
|
|
|
|
|
|
|
|
503
|
784
|
50
|
|
|
|
1805
|
$ctx->{log}->($ctx, 'eval', $arg, "statement: $stmt") if $ctx->{log}; |
504
|
|
|
|
|
|
|
|
505
|
|
|
|
|
|
|
# (4) insert remaining assignments at front of block |
506
|
|
|
|
|
|
|
# |
507
|
784
|
|
|
|
|
1729
|
$stmt = $ctx->insert_assignments($stmt); |
508
|
|
|
|
|
|
|
|
509
|
|
|
|
|
|
|
# (5) flush output buffer |
510
|
|
|
|
|
|
|
# |
511
|
784
|
50
|
66
|
|
|
3058
|
if ($ctx->{toplevel} && exists $ctx->{varmap}{stdout}) { |
512
|
722
|
100
|
|
|
|
1654
|
if (exists $ctx->{varmap}{stdout}{handler}) { |
513
|
|
|
|
|
|
|
# call handler at the end of the request |
514
|
|
|
|
|
|
|
# see: https://www.php.net/manual/en/function.ob-start.php |
515
|
|
|
|
|
|
|
# |
516
|
1
|
|
|
|
|
8
|
my $e = $parser->setcall('ob_end_flush', []); |
517
|
1
|
|
|
|
|
5
|
my $k = $ctx->exec_statement($e); |
518
|
|
|
|
|
|
|
|
519
|
1
|
|
|
|
|
4
|
my @seq = (); |
520
|
1
|
|
|
|
|
6
|
$parser->flatten_block($stmt, \@seq); |
521
|
1
|
|
|
|
|
14
|
$stmt = $parser->setblk('flat', [@seq, $k]); |
522
|
|
|
|
|
|
|
} |
523
|
|
|
|
|
|
|
} |
524
|
|
|
|
|
|
|
|
525
|
|
|
|
|
|
|
# (6) log stdout |
526
|
|
|
|
|
|
|
# |
527
|
784
|
50
|
66
|
|
|
2555
|
if ($ctx->{toplevel} && exists $ctx->{varmap}{stdout}) { |
528
|
722
|
100
|
|
|
|
1082
|
if (@{$ctx->{varmap}{stdout}{buf}}) { |
|
722
|
|
|
|
|
1807
|
|
529
|
96
|
|
|
|
|
234
|
my @stdout = @{$ctx->{varmap}{stdout}{buf}}; |
|
96
|
|
|
|
|
338
|
|
530
|
96
|
|
|
|
|
187
|
my $v = '$STDOUT'; |
531
|
96
|
|
|
|
|
147
|
my $k; |
532
|
96
|
|
|
|
|
329
|
merge_str_list(\@stdout, $parser); |
533
|
96
|
|
|
|
|
334
|
while (my $s = shift @stdout) { |
534
|
97
|
100
|
|
|
|
626
|
if (defined $k) { |
535
|
1
|
|
|
|
|
3
|
$k = $parser->setexpr('.', $k, $s); |
536
|
|
|
|
|
|
|
} else { |
537
|
96
|
|
|
|
|
248
|
$k = $s; |
538
|
|
|
|
|
|
|
} |
539
|
|
|
|
|
|
|
} |
540
|
96
|
50
|
|
|
|
257
|
unless (exists $ctx->{skip}{stdout}) { |
541
|
96
|
|
|
|
|
271
|
my $e = $parser->setexpr('=', $v, $k); |
542
|
96
|
|
|
|
|
215
|
my @seq = (); |
543
|
96
|
|
|
|
|
488
|
$parser->flatten_block($stmt, \@seq); |
544
|
96
|
|
|
|
|
384
|
$stmt = $parser->setblk('flat', [@seq, $e]); |
545
|
|
|
|
|
|
|
} |
546
|
|
|
|
|
|
|
} |
547
|
|
|
|
|
|
|
} |
548
|
|
|
|
|
|
|
|
549
|
|
|
|
|
|
|
# (7) flatten block if necessary |
550
|
|
|
|
|
|
|
# |
551
|
784
|
100
|
|
|
|
1738
|
if (is_block($stmt)) { |
552
|
519
|
|
|
|
|
757
|
my ($type, $a) = @{$parser->{strmap}->{$stmt}}; |
|
519
|
|
|
|
|
1248
|
|
553
|
519
|
100
|
|
|
|
1395
|
if ($type ne 'flat') { |
554
|
12
|
|
|
|
|
31
|
my @seq = (); |
555
|
12
|
|
|
|
|
47
|
$parser->flatten_block($stmt, \@seq); |
556
|
12
|
50
|
|
|
|
35
|
if (scalar @seq > 1) { |
|
|
0
|
|
|
|
|
|
557
|
12
|
|
|
|
|
35
|
$stmt = $parser->setblk('flat', [@seq]); |
558
|
|
|
|
|
|
|
} elsif (scalar @seq > 0) { |
559
|
0
|
|
|
|
|
0
|
$stmt = $seq[0]; |
560
|
|
|
|
|
|
|
} |
561
|
|
|
|
|
|
|
} |
562
|
|
|
|
|
|
|
} |
563
|
784
|
|
|
|
|
1126
|
my $outlist; |
564
|
784
|
100
|
50
|
|
|
1682
|
$outlist = join(' ', @{$ctx->{varmap}{stdout}{buf}}) if (exists $ctx->{varmap}{stdout} && scalar @{$ctx->{varmap}{stdout}{buf}}); |
|
104
|
|
|
|
|
324
|
|
|
784
|
|
|
|
|
2306
|
|
565
|
784
|
0
|
|
|
|
1596
|
$ctx->{log}->($ctx, 'eval', $arg, "got: $stmt%s", defined $outlist ? ' ('.$outlist.')' : '') if $ctx->{log}; |
|
|
50
|
|
|
|
|
|
566
|
784
|
|
|
|
|
3044
|
return $stmt; |
567
|
|
|
|
|
|
|
} elsif (is_null($arg)) { # might be return from nested eval |
568
|
0
|
0
|
|
|
|
0
|
$ctx->{log}->($ctx, 'eval', $arg, "got null") if $ctx->{log}; |
569
|
0
|
|
|
|
|
0
|
return $arg; # stray null statements are removed by flatten_block() |
570
|
|
|
|
|
|
|
} |
571
|
0
|
|
|
|
|
0
|
return; |
572
|
|
|
|
|
|
|
} |
573
|
|
|
|
|
|
|
|
574
|
|
|
|
|
|
|
# check if elem without recursive subreferences |
575
|
|
|
|
|
|
|
# |
576
|
|
|
|
|
|
|
sub is_flat_elem { |
577
|
859
|
|
|
859
|
0
|
1705
|
my ($s, $parser) = @_; |
578
|
|
|
|
|
|
|
|
579
|
859
|
100
|
|
|
|
2040
|
if ($s =~ /^#elem\d+$/) { |
580
|
17
|
|
|
|
|
57
|
my ($v, $i) = @{$parser->{strmap}->{$s}}; |
|
17
|
|
|
|
|
77
|
|
581
|
17
|
50
|
|
|
|
55
|
if (defined $v) { |
582
|
17
|
100
|
|
|
|
45
|
if (!is_variable($v)) { |
583
|
4
|
|
|
|
|
19
|
return 0; |
584
|
|
|
|
|
|
|
} |
585
|
|
|
|
|
|
|
} |
586
|
13
|
50
|
|
|
|
43
|
if (defined $i) { |
587
|
13
|
100
|
|
|
|
43
|
if (!is_strval($i)) { |
588
|
2
|
|
|
|
|
13
|
return 0; |
589
|
|
|
|
|
|
|
} |
590
|
|
|
|
|
|
|
} |
591
|
11
|
|
|
|
|
61
|
return 1; |
592
|
|
|
|
|
|
|
} |
593
|
842
|
|
|
|
|
3224
|
return 0; |
594
|
|
|
|
|
|
|
} |
595
|
|
|
|
|
|
|
|
596
|
|
|
|
|
|
|
# check if elem is anonymous function call, and return it |
597
|
|
|
|
|
|
|
# |
598
|
|
|
|
|
|
|
sub _anon_func_call { |
599
|
20
|
|
|
20
|
|
61
|
my ($parser, $s) = @_; |
600
|
|
|
|
|
|
|
|
601
|
20
|
50
|
|
|
|
59
|
if ($s =~ /^#call\d+$/) { |
602
|
0
|
|
|
|
|
0
|
my ($f, $a) = @{$parser->{strmap}->{$s}}; |
|
0
|
|
|
|
|
0
|
|
603
|
0
|
0
|
|
|
|
0
|
if ($f =~ /^#fun\d+$/) { |
604
|
0
|
|
|
|
|
0
|
my ($fn, $fa, $fb, $fp) = @{$parser->{strmap}->{$f}}; |
|
0
|
|
|
|
|
0
|
|
605
|
0
|
0
|
|
|
|
0
|
if (!defined $fn) { |
606
|
0
|
|
|
|
|
0
|
return $f; |
607
|
|
|
|
|
|
|
} |
608
|
|
|
|
|
|
|
} |
609
|
|
|
|
|
|
|
} |
610
|
20
|
|
|
|
|
61
|
return; |
611
|
|
|
|
|
|
|
} |
612
|
|
|
|
|
|
|
|
613
|
|
|
|
|
|
|
# check if expression in block contains a local variable |
614
|
|
|
|
|
|
|
# |
615
|
|
|
|
|
|
|
sub contains_local_var { |
616
|
258
|
|
|
258
|
0
|
457
|
my ($ctx, $info) = @_; |
617
|
|
|
|
|
|
|
|
618
|
258
|
|
|
|
|
348
|
foreach my $var (keys %{$info->{vars}}) { |
|
258
|
|
|
|
|
650
|
|
619
|
11
|
100
|
|
|
|
36
|
next if $ctx->is_superglobal($var); |
620
|
4
|
50
|
|
|
|
15
|
next if $ctx->is_global_var($var); |
621
|
|
|
|
|
|
|
|
622
|
4
|
|
|
|
|
13
|
return 1; |
623
|
|
|
|
|
|
|
} |
624
|
254
|
|
|
|
|
1000
|
return 0; |
625
|
|
|
|
|
|
|
} |
626
|
|
|
|
|
|
|
|
627
|
|
|
|
|
|
|
# if expression in block contains an unresolvable variable, then return it |
628
|
|
|
|
|
|
|
# |
629
|
|
|
|
|
|
|
sub unresolvable_var { |
630
|
1121
|
|
|
1121
|
0
|
2431
|
my ($ctx, $info) = @_; |
631
|
|
|
|
|
|
|
|
632
|
1121
|
|
|
|
|
1450
|
foreach my $var (keys %{$info->{vars}}) { |
|
1121
|
|
|
|
|
2946
|
|
633
|
194
|
100
|
|
|
|
446
|
next if $ctx->is_superglobal($var); |
634
|
|
|
|
|
|
|
|
635
|
188
|
|
|
|
|
492
|
my $val = $ctx->getvar($var, 1); |
636
|
188
|
100
|
|
|
|
660
|
if (!defined $val) { |
|
|
100
|
|
|
|
|
|
637
|
7
|
|
|
|
|
23
|
return $var; |
638
|
|
|
|
|
|
|
} elsif ($val eq '#unresolved') { |
639
|
14
|
|
|
|
|
90
|
return $var; |
640
|
|
|
|
|
|
|
} |
641
|
|
|
|
|
|
|
} |
642
|
1100
|
|
|
|
|
3452
|
return; |
643
|
|
|
|
|
|
|
} |
644
|
|
|
|
|
|
|
|
645
|
|
|
|
|
|
|
# if expression in block contains an unresolvable local or instance variable, then return it |
646
|
|
|
|
|
|
|
# |
647
|
|
|
|
|
|
|
sub unresolvable_local_var { |
648
|
0
|
|
|
0
|
0
|
0
|
my ($ctx, $info) = @_; |
649
|
|
|
|
|
|
|
|
650
|
0
|
|
|
|
|
0
|
foreach my $var (keys %{$info->{vars}}) { |
|
0
|
|
|
|
|
0
|
|
651
|
0
|
0
|
|
|
|
0
|
next if $ctx->is_superglobal($var); |
652
|
0
|
0
|
|
|
|
0
|
next if $ctx->is_global_var($var); |
653
|
|
|
|
|
|
|
|
654
|
0
|
|
|
|
|
0
|
my $val = $ctx->getvar($var, 1); |
655
|
0
|
0
|
|
|
|
0
|
if (!defined $val) { |
|
|
0
|
|
|
|
|
|
656
|
0
|
|
|
|
|
0
|
return $var; |
657
|
|
|
|
|
|
|
} elsif ($val eq '#unresolved') { |
658
|
0
|
|
|
|
|
0
|
return $var; |
659
|
|
|
|
|
|
|
} |
660
|
|
|
|
|
|
|
} |
661
|
0
|
|
|
|
|
0
|
return; |
662
|
|
|
|
|
|
|
} |
663
|
|
|
|
|
|
|
|
664
|
|
|
|
|
|
|
# return new list where consecutive strings are merged |
665
|
|
|
|
|
|
|
# (keeps constants intact) |
666
|
|
|
|
|
|
|
# |
667
|
|
|
|
|
|
|
sub merge_str_list { |
668
|
102
|
|
|
102
|
0
|
226
|
my ($seq, $parser) = @_; |
669
|
102
|
|
|
|
|
167
|
my @list = (); |
670
|
|
|
|
|
|
|
|
671
|
102
|
|
|
|
|
263
|
while (my $s = shift @$seq) { |
672
|
106
|
100
|
100
|
|
|
302
|
if (is_strval($s) && !is_const($s)) { |
673
|
99
|
|
|
|
|
173
|
my $i; |
674
|
99
|
|
|
|
|
252
|
for ($i=0; $i < scalar @$seq; $i++) { |
675
|
29
|
100
|
100
|
|
|
120
|
last unless (is_strval($seq->[$i]) && !is_const($seq->[$i])); |
676
|
|
|
|
|
|
|
} |
677
|
99
|
100
|
|
|
|
531
|
if ($i > 0) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
678
|
17
|
|
|
|
|
63
|
my @list = ($s, splice(@$seq, 0, $i)); |
679
|
17
|
|
|
|
|
49
|
my $str = join('', map { $parser->{strmap}->{$_} } @list); |
|
43
|
|
|
|
|
136
|
|
680
|
17
|
|
|
|
|
61
|
$s = $parser->setstr($str); |
681
|
|
|
|
|
|
|
} elsif ($s =~ /^#(const|num)\d+$/) { |
682
|
17
|
|
|
|
|
48
|
my $str = $parser->{strmap}->{$s}; |
683
|
17
|
|
|
|
|
53
|
$s = $parser->setstr($str); |
684
|
|
|
|
|
|
|
} elsif (is_null($s)) { |
685
|
1
|
|
|
|
|
5
|
$s = $parser->setstr(''); |
686
|
|
|
|
|
|
|
} |
687
|
|
|
|
|
|
|
} |
688
|
106
|
|
|
|
|
411
|
push(@list, $s); |
689
|
|
|
|
|
|
|
} |
690
|
102
|
|
|
|
|
211
|
@$seq = @list; |
691
|
102
|
|
|
|
|
187
|
return; |
692
|
|
|
|
|
|
|
} |
693
|
|
|
|
|
|
|
|
694
|
|
|
|
|
|
|
# return flat block or single statement |
695
|
|
|
|
|
|
|
# |
696
|
|
|
|
|
|
|
sub _flat_block_or_single { |
697
|
128
|
|
|
128
|
|
284
|
my ($parser, $seq) = @_; |
698
|
|
|
|
|
|
|
|
699
|
128
|
100
|
|
|
|
351
|
if (scalar @$seq == 1) { |
700
|
12
|
|
|
|
|
47
|
return $seq->[0]; |
701
|
|
|
|
|
|
|
} |
702
|
116
|
|
|
|
|
405
|
return $parser->setblk('flat', [@$seq]); |
703
|
|
|
|
|
|
|
} |
704
|
|
|
|
|
|
|
|
705
|
|
|
|
|
|
|
# convert flat block or statement to code block |
706
|
|
|
|
|
|
|
# |
707
|
|
|
|
|
|
|
sub _to_code_block { |
708
|
10
|
|
|
10
|
|
24
|
my ($parser, $s) = @_; |
709
|
|
|
|
|
|
|
|
710
|
10
|
50
|
|
|
|
34
|
if (is_block($s)) { |
711
|
10
|
|
|
|
|
17
|
my ($type, $a) = @{$parser->{strmap}->{$s}}; |
|
10
|
|
|
|
|
40
|
|
712
|
10
|
50
|
|
|
|
39
|
if ($type ne 'std') { |
713
|
0
|
|
|
|
|
0
|
my @seq = (); |
714
|
0
|
|
|
|
|
0
|
$parser->flatten_block($s, \@seq); |
715
|
0
|
|
|
|
|
0
|
$s = $parser->setblk('std', [@seq]); |
716
|
|
|
|
|
|
|
} |
717
|
|
|
|
|
|
|
} else { |
718
|
0
|
|
|
|
|
0
|
$s = $parser->setblk('std', [$s]); |
719
|
|
|
|
|
|
|
} |
720
|
10
|
|
|
|
|
23
|
return $s; |
721
|
|
|
|
|
|
|
} |
722
|
|
|
|
|
|
|
|
723
|
|
|
|
|
|
|
# convert statements to anon function call without parameters |
724
|
|
|
|
|
|
|
# (if not already anon function) |
725
|
|
|
|
|
|
|
# |
726
|
|
|
|
|
|
|
sub _to_anon_func_call { |
727
|
4
|
|
|
4
|
|
14
|
my ($parser, $s) = @_; |
728
|
|
|
|
|
|
|
|
729
|
4
|
50
|
|
|
|
14
|
unless (_anon_func_call($parser, $s)) { |
730
|
4
|
|
|
|
|
15
|
$s = _to_code_block($parser, $s); |
731
|
4
|
|
|
|
|
31
|
my $f = $parser->setfun(undef, [], $s); |
732
|
4
|
|
|
|
|
21
|
$s = $parser->setcall($f, []); |
733
|
|
|
|
|
|
|
} |
734
|
4
|
|
|
|
|
34
|
return $s; |
735
|
|
|
|
|
|
|
} |
736
|
|
|
|
|
|
|
|
737
|
|
|
|
|
|
|
# get first block elem or elem itself |
738
|
|
|
|
|
|
|
# |
739
|
|
|
|
|
|
|
sub _first_statement { |
740
|
0
|
|
|
0
|
|
0
|
my ($parser, $s) = @_; |
741
|
|
|
|
|
|
|
|
742
|
0
|
0
|
|
|
|
0
|
if (is_block($s)) { |
743
|
0
|
|
|
|
|
0
|
my ($type, $a) = @{$parser->{strmap}->{$s}}; |
|
0
|
|
|
|
|
0
|
|
744
|
0
|
0
|
|
|
|
0
|
if (scalar @$a > 0) { |
745
|
0
|
|
|
|
|
0
|
return $a->[0]; |
746
|
|
|
|
|
|
|
} |
747
|
|
|
|
|
|
|
} |
748
|
0
|
|
|
|
|
0
|
return $s; |
749
|
|
|
|
|
|
|
} |
750
|
|
|
|
|
|
|
|
751
|
|
|
|
|
|
|
# if the final element of a block is a #stmt matching pattern, then return this #stmt |
752
|
|
|
|
|
|
|
# |
753
|
|
|
|
|
|
|
sub _final_break { |
754
|
2763
|
|
|
2763
|
|
5180
|
my ($parser, $s, $pattern) = @_; |
755
|
|
|
|
|
|
|
|
756
|
2763
|
100
|
|
|
|
5205
|
if (is_block($s)) { |
757
|
318
|
|
|
|
|
538
|
my ($type, $a) = @{$parser->{strmap}->{$s}}; |
|
318
|
|
|
|
|
915
|
|
758
|
318
|
100
|
|
|
|
858
|
if (scalar @$a > 0) { |
759
|
300
|
|
|
|
|
769
|
return &_final_break($parser, $a->[-1], $pattern); |
760
|
|
|
|
|
|
|
} |
761
|
|
|
|
|
|
|
} |
762
|
2463
|
100
|
|
|
|
6191
|
if ($s =~ /^#stmt\d+$/) { |
763
|
767
|
|
|
|
|
1651
|
my $cmd = $parser->{strmap}->{$s}->[0]; |
764
|
767
|
100
|
|
|
|
14111
|
if ($cmd =~ /^$pattern$/) { |
765
|
391
|
|
|
|
|
1565
|
return $s; |
766
|
|
|
|
|
|
|
} |
767
|
|
|
|
|
|
|
} |
768
|
2072
|
|
|
|
|
4180
|
return; |
769
|
|
|
|
|
|
|
} |
770
|
|
|
|
|
|
|
|
771
|
|
|
|
|
|
|
# if the a block contains functions, then return function list |
772
|
|
|
|
|
|
|
# |
773
|
|
|
|
|
|
|
sub _contained_functions { |
774
|
0
|
|
|
0
|
|
0
|
my ($parser, $s) = @_; |
775
|
|
|
|
|
|
|
|
776
|
0
|
0
|
|
|
|
0
|
if (is_block($s)) { |
777
|
0
|
|
|
|
|
0
|
my ($type, $a) = @{$parser->{strmap}->{$s}}; |
|
0
|
|
|
|
|
0
|
|
778
|
0
|
|
|
|
|
0
|
my @list = (); |
779
|
0
|
|
|
|
|
0
|
foreach my $stmt (@$a) { |
780
|
0
|
|
|
|
|
0
|
my $sublist = &_contained_functions($parser, $stmt); |
781
|
0
|
0
|
|
|
|
0
|
if (scalar @$sublist > 0) { |
782
|
0
|
|
|
|
|
0
|
push(@list, @$sublist); |
783
|
|
|
|
|
|
|
} |
784
|
|
|
|
|
|
|
} |
785
|
0
|
|
|
|
|
0
|
return \@list; |
786
|
|
|
|
|
|
|
} |
787
|
0
|
0
|
|
|
|
0
|
if ($s =~ /^#fun\d+$/) { |
788
|
0
|
|
|
|
|
0
|
return [$s]; |
789
|
|
|
|
|
|
|
} |
790
|
0
|
|
|
|
|
0
|
return []; |
791
|
|
|
|
|
|
|
} |
792
|
|
|
|
|
|
|
|
793
|
|
|
|
|
|
|
# if a block contains calls with resolved params, then return call list |
794
|
|
|
|
|
|
|
# |
795
|
|
|
|
|
|
|
sub _contained_resolved_calls { |
796
|
0
|
|
|
0
|
|
0
|
my ($parser, $s) = @_; |
797
|
|
|
|
|
|
|
|
798
|
0
|
0
|
|
|
|
0
|
if (is_block($s)) { |
799
|
0
|
|
|
|
|
0
|
my ($type, $a) = @{$parser->{strmap}->{$s}}; |
|
0
|
|
|
|
|
0
|
|
800
|
0
|
|
|
|
|
0
|
my @list = (); |
801
|
0
|
|
|
|
|
0
|
foreach my $stmt (@$a) { |
802
|
0
|
|
|
|
|
0
|
my $sublist = &_contained_resolved_calls($parser, $stmt); |
803
|
0
|
0
|
|
|
|
0
|
if (scalar @$sublist > 0) { |
804
|
0
|
|
|
|
|
0
|
push(@list, @$sublist); |
805
|
|
|
|
|
|
|
} |
806
|
|
|
|
|
|
|
} |
807
|
0
|
|
|
|
|
0
|
return \@list; |
808
|
|
|
|
|
|
|
} |
809
|
0
|
0
|
|
|
|
0
|
if ($s =~ /^#call\d+$/) { |
810
|
0
|
|
|
|
|
0
|
my ($name, $args) = @{$parser->{strmap}->{$s}}; |
|
0
|
|
|
|
|
0
|
|
811
|
0
|
|
|
|
|
0
|
foreach my $p (@$args) { |
812
|
0
|
0
|
0
|
|
|
0
|
unless (is_strval($p) || is_array($p)) { |
813
|
0
|
|
|
|
|
0
|
return []; |
814
|
|
|
|
|
|
|
} |
815
|
|
|
|
|
|
|
} |
816
|
0
|
|
|
|
|
0
|
return [$s]; |
817
|
|
|
|
|
|
|
} |
818
|
0
|
|
|
|
|
0
|
return []; |
819
|
|
|
|
|
|
|
} |
820
|
|
|
|
|
|
|
|
821
|
|
|
|
|
|
|
sub _get_echo_arglist { |
822
|
104
|
|
|
104
|
|
183
|
my ($parser, $s) = @_; |
823
|
|
|
|
|
|
|
|
824
|
104
|
100
|
|
|
|
296
|
if ($s =~ /^#stmt\d+$/) { |
825
|
40
|
|
|
|
|
89
|
my $cmd = $parser->{strmap}->{$s}->[0]; |
826
|
40
|
|
|
|
|
91
|
my $arglist = $parser->{strmap}->{$s}->[1]; |
827
|
40
|
50
|
|
|
|
97
|
if ($cmd eq 'echo') { |
828
|
40
|
|
|
|
|
57
|
my $all_str = 1; |
829
|
|
|
|
|
|
|
|
830
|
40
|
|
|
|
|
78
|
foreach my $p (@$arglist) { |
831
|
40
|
50
|
|
|
|
79
|
$all_str = 0 if !is_strval($p); |
832
|
|
|
|
|
|
|
} |
833
|
40
|
|
|
|
|
114
|
return ($arglist, $all_str); |
834
|
|
|
|
|
|
|
} |
835
|
|
|
|
|
|
|
} |
836
|
64
|
|
|
|
|
140
|
return; |
837
|
|
|
|
|
|
|
} |
838
|
|
|
|
|
|
|
|
839
|
|
|
|
|
|
|
# if a unresolved #stmt or #call matching pattern remains in a function, return this element |
840
|
|
|
|
|
|
|
# |
841
|
|
|
|
|
|
|
sub _skipped_call { |
842
|
1350
|
|
|
1350
|
|
2702
|
my ($parser, $s, $pattern, $info) = @_; |
843
|
|
|
|
|
|
|
|
844
|
1350
|
|
|
|
|
1960
|
foreach my $call (keys %{$info->{calls}}) { |
|
1350
|
|
|
|
|
4391
|
|
845
|
102
|
100
|
|
|
|
467
|
next if ($info->{calls}{$call}) eq 'return'; # allow skipped call in return? |
846
|
|
|
|
|
|
|
|
847
|
95
|
|
|
|
|
210
|
my $name = $call; |
848
|
95
|
50
|
|
|
|
362
|
if ($name !~ /^(ob_start|exit|die|__halt_compiler)$/i) { # allow skipped exit-like calls |
849
|
95
|
50
|
|
|
|
230
|
if ($name !~ /^(error_reporting)$/i) { # allow skipped calls without side effects |
850
|
95
|
50
|
|
|
|
644
|
if ($name =~ /^$pattern$/) { |
851
|
95
|
|
|
|
|
378
|
return $call; |
852
|
|
|
|
|
|
|
} |
853
|
|
|
|
|
|
|
} |
854
|
|
|
|
|
|
|
} |
855
|
|
|
|
|
|
|
} |
856
|
1255
|
|
|
|
|
1992
|
foreach my $stmt (keys %{$info->{stmts}}) { |
|
1255
|
|
|
|
|
2843
|
|
857
|
51
|
|
|
|
|
169
|
my $cmd = $parser->{strmap}->{$stmt}->[0]; |
858
|
51
|
100
|
|
|
|
173
|
if ($cmd eq 'echo') { |
|
|
50
|
|
|
|
|
|
859
|
|
|
|
|
|
|
# 'echo' is kept inline for non-string argument |
860
|
|
|
|
|
|
|
# |
861
|
50
|
|
|
|
|
106
|
my $arglist = $parser->{strmap}->{$stmt}->[1]; |
862
|
50
|
50
|
33
|
|
|
241
|
if ((scalar @$arglist > 1) || !is_strval($arglist->[0])) { |
863
|
0
|
0
|
|
|
|
0
|
if ($cmd =~ /^$pattern$/) { |
864
|
0
|
|
|
|
|
0
|
return $stmt; |
865
|
|
|
|
|
|
|
} |
866
|
|
|
|
|
|
|
} |
867
|
|
|
|
|
|
|
} elsif ($cmd ne 'global') { # 'global $var' is always executed |
868
|
1
|
50
|
|
|
|
24
|
if ($cmd =~ /^$pattern$/) { |
869
|
1
|
|
|
|
|
5
|
return $stmt; |
870
|
|
|
|
|
|
|
} |
871
|
|
|
|
|
|
|
} |
872
|
|
|
|
|
|
|
} |
873
|
1254
|
|
|
|
|
3599
|
return; |
874
|
|
|
|
|
|
|
} |
875
|
|
|
|
|
|
|
|
876
|
|
|
|
|
|
|
# collect info about unresolved calls and assignments in a function call |
877
|
|
|
|
|
|
|
# - $info->{unresolved} = names of unresolvable calls and assignments |
878
|
|
|
|
|
|
|
# - $info->{global_assigns} = global variables with resolved assignments |
879
|
|
|
|
|
|
|
# - $info->{local_assigns} = local variables with resolved assignments |
880
|
|
|
|
|
|
|
# |
881
|
|
|
|
|
|
|
sub get_unresolved_info { |
882
|
554
|
|
|
554
|
0
|
1192
|
my ($ctx, $cmd, $stmt) = @_; |
883
|
554
|
|
|
|
|
1007
|
my $parser = $ctx->{parser}; |
884
|
|
|
|
|
|
|
|
885
|
554
|
|
|
|
|
4175
|
my $info = {vars => {}, calls => {}, stmts => {}, assigns => {}, noassigns => {}, resolved => {$cmd => 1}, unresolved => {}, global_assigns => {}, local_assigns => {}}; |
886
|
554
|
|
|
|
|
2238
|
$parser->stmt_info($stmt, $info); |
887
|
|
|
|
|
|
|
|
888
|
554
|
|
|
|
|
815
|
foreach my $call (keys %{$info->{calls}}) { |
|
554
|
|
|
|
|
1636
|
|
889
|
201
|
|
|
|
|
514
|
my $fun = $ctx->getfun($call); |
890
|
|
|
|
|
|
|
|
891
|
201
|
|
|
|
|
416
|
$call = lc($call); |
892
|
|
|
|
|
|
|
|
893
|
201
|
100
|
|
|
|
645
|
if (defined $fun) { |
|
|
100
|
|
|
|
|
|
894
|
32
|
|
|
|
|
51
|
my ($name, $a, $b, $p) = @{$parser->{strmap}->{$fun}}; |
|
32
|
|
|
|
|
108
|
|
895
|
|
|
|
|
|
|
|
896
|
|
|
|
|
|
|
# check if function was already visited |
897
|
|
|
|
|
|
|
# |
898
|
32
|
50
|
|
|
|
93
|
if (!exists $info->{resolved}{$call}) { |
899
|
32
|
|
|
|
|
87
|
my $subinfo = $ctx->get_unresolved_info($call, $b); |
900
|
|
|
|
|
|
|
|
901
|
32
|
|
|
|
|
54
|
$info->{global_assigns} = {%{$info->{global_assigns}}, %{$subinfo->{global_assigns}}}; |
|
32
|
|
|
|
|
62
|
|
|
32
|
|
|
|
|
84
|
|
902
|
32
|
|
|
|
|
71
|
$info->{unresolved} = {%{$info->{unresolved}}, %{$subinfo->{unresolved}}}; |
|
32
|
|
|
|
|
71
|
|
|
32
|
|
|
|
|
78
|
|
903
|
32
|
|
|
|
|
65
|
$info->{resolved} = {%{$info->{resolved}}, %{$subinfo->{resolved}}}; |
|
32
|
|
|
|
|
73
|
|
|
32
|
|
|
|
|
84
|
|
904
|
32
|
|
|
|
|
177
|
$info->{resolved}{$call} = 1; |
905
|
|
|
|
|
|
|
} |
906
|
|
|
|
|
|
|
} elsif (my $f = PHP::Decode::Func::get_php_func($call)) { |
907
|
40
|
100
|
|
|
|
108
|
if (PHP::Decode::Func::func_may_call_callbacks($call)) { |
908
|
2
|
|
|
|
|
5
|
my $skip = 0; |
909
|
2
|
50
|
|
|
|
6
|
if ($call eq 'array_filter') { |
910
|
0
|
|
|
|
|
0
|
my @list = keys %{$info->{callargs}{$call}}; |
|
0
|
|
|
|
|
0
|
|
911
|
0
|
0
|
0
|
|
|
0
|
if ((scalar @list == 1) && ($list[0] eq '1')) { |
912
|
|
|
|
|
|
|
# one-arg array_filter has no callable |
913
|
0
|
0
|
|
|
|
0
|
$ctx->{log}->($ctx, 'exec', $stmt, "get_unresolved_info $cmd: skip 1-arg $call") if $ctx->{log}; |
914
|
0
|
|
|
|
|
0
|
$skip = 1; |
915
|
|
|
|
|
|
|
} |
916
|
|
|
|
|
|
|
} |
917
|
2
|
50
|
|
|
|
6
|
unless ($skip) { |
918
|
2
|
|
|
|
|
7
|
$info->{unresolved}{$call} = 1; |
919
|
|
|
|
|
|
|
} |
920
|
|
|
|
|
|
|
} |
921
|
|
|
|
|
|
|
# func without side-effects on vars here |
922
|
|
|
|
|
|
|
} else { |
923
|
129
|
|
|
|
|
338
|
$info->{unresolved}{$call} = 1; |
924
|
|
|
|
|
|
|
} |
925
|
|
|
|
|
|
|
} |
926
|
554
|
|
|
|
|
967
|
foreach my $var (keys %{$info->{assigns}}) { |
|
554
|
|
|
|
|
1405
|
|
927
|
273
|
50
|
|
|
|
847
|
if ($var =~ /^#elem\d+$/) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
928
|
0
|
|
|
|
|
0
|
my $elemlist = _get_elemlist($parser, $var); |
929
|
0
|
|
|
|
|
0
|
my ($v, $i) = @{$parser->{strmap}->{$elemlist->[0]}}; |
|
0
|
|
|
|
|
0
|
|
930
|
|
|
|
|
|
|
|
931
|
0
|
|
|
|
|
0
|
my $g = $parser->globalvar_to_var($v, $i); |
932
|
0
|
0
|
|
|
|
0
|
if (defined $g) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
933
|
0
|
|
|
|
|
0
|
$info->{global_assigns}{$g} = 1; |
934
|
|
|
|
|
|
|
} elsif ($ctx->is_superglobal($v)) { |
935
|
0
|
|
|
|
|
0
|
$info->{global_assigns}{$var} = 1; |
936
|
|
|
|
|
|
|
} elsif (is_variable($v)) { |
937
|
0
|
|
|
|
|
0
|
my ($g) = global_split($v); |
938
|
0
|
0
|
|
|
|
0
|
if (defined $g) { |
939
|
|
|
|
|
|
|
# access on global array-var |
940
|
0
|
|
|
|
|
0
|
$info->{global_assigns}{$g} = 1; |
941
|
|
|
|
|
|
|
} else { |
942
|
0
|
|
|
|
|
0
|
$info->{local_assigns}{$v} = 1; |
943
|
|
|
|
|
|
|
} |
944
|
|
|
|
|
|
|
} else { |
945
|
0
|
|
|
|
|
0
|
$info->{unresolved}{$var} = 1; |
946
|
|
|
|
|
|
|
} |
947
|
|
|
|
|
|
|
} elsif (is_variable($var)) { |
948
|
265
|
|
|
|
|
630
|
my ($g) = global_split($var); |
949
|
265
|
100
|
|
|
|
654
|
if (defined $g) { |
950
|
26
|
|
|
|
|
68
|
$info->{global_assigns}{$g} = 1; |
951
|
26
|
|
|
|
|
55
|
next; |
952
|
|
|
|
|
|
|
} |
953
|
239
|
100
|
|
|
|
610
|
if ($ctx->is_superglobal($var)) { |
954
|
2
|
|
|
|
|
5
|
$info->{global_assigns}{$var} = 1; |
955
|
2
|
|
|
|
|
17
|
next; |
956
|
|
|
|
|
|
|
} |
957
|
237
|
|
|
|
|
665
|
$info->{local_assigns}{$var} = 1; |
958
|
|
|
|
|
|
|
} elsif ($var =~ /^#obj\d+$/) { |
959
|
7
|
|
|
|
|
24
|
$info->{local_assigns}{$var} = 1; |
960
|
|
|
|
|
|
|
} else { |
961
|
1
|
|
|
|
|
3
|
$info->{unresolved}{$var} = 1; |
962
|
|
|
|
|
|
|
} |
963
|
|
|
|
|
|
|
} |
964
|
554
|
|
|
|
|
1999
|
return $info; |
965
|
|
|
|
|
|
|
} |
966
|
|
|
|
|
|
|
|
967
|
|
|
|
|
|
|
# if a function returns just a single #call with same signature, then return this #call |
968
|
|
|
|
|
|
|
# |
969
|
|
|
|
|
|
|
sub _is_wrapped_call { |
970
|
209
|
|
|
209
|
|
415
|
my ($parser, $s) = @_; |
971
|
|
|
|
|
|
|
|
972
|
209
|
50
|
|
|
|
768
|
unless ($s =~ /^#fun\d+$/) { |
973
|
0
|
|
|
|
|
0
|
return; |
974
|
|
|
|
|
|
|
} |
975
|
209
|
|
|
|
|
348
|
my ($f, $a, $b, $p) = @{$parser->{strmap}->{$s}}; |
|
209
|
|
|
|
|
572
|
|
976
|
209
|
|
|
|
|
575
|
$s = $parser->flatten_block_if_single($b); |
977
|
|
|
|
|
|
|
|
978
|
209
|
100
|
|
|
|
576
|
if ($s =~ /^#stmt\d+$/) { |
979
|
92
|
|
|
|
|
209
|
my $cmd = $parser->{strmap}->{$s}->[0]; |
980
|
92
|
100
|
|
|
|
274
|
if (lc($cmd) eq 'return') { |
981
|
61
|
|
|
|
|
149
|
my $val = $parser->{strmap}->{$s}->[1]; |
982
|
61
|
100
|
|
|
|
214
|
if ($val =~ /^#call\d+$/) { |
983
|
7
|
|
|
|
|
28
|
my ($name, $arglist) = @{$parser->{strmap}->{$val}}; |
|
7
|
|
|
|
|
23
|
|
984
|
|
|
|
|
|
|
|
985
|
|
|
|
|
|
|
# eval might create local vars |
986
|
7
|
100
|
100
|
|
|
24
|
if (is_symbol($name) && (lc($name) ne 'eval') && (scalar @$arglist == scalar @$a)) { |
|
|
|
66
|
|
|
|
|
987
|
5
|
|
|
|
|
13
|
my $i = 0; |
988
|
5
|
|
|
|
|
10
|
my $arg_match = 1; |
989
|
5
|
|
|
|
|
15
|
foreach my $k (@$arglist) { |
990
|
4
|
100
|
|
|
|
19
|
if ($k ne $a->[$i]) { |
991
|
1
|
|
|
|
|
5
|
$arg_match = 0; |
992
|
|
|
|
|
|
|
} |
993
|
4
|
|
|
|
|
12
|
$i++; |
994
|
|
|
|
|
|
|
} |
995
|
5
|
100
|
|
|
|
18
|
if ($arg_match) { |
996
|
4
|
|
|
|
|
13
|
return $name; |
997
|
|
|
|
|
|
|
} |
998
|
|
|
|
|
|
|
} |
999
|
|
|
|
|
|
|
} |
1000
|
|
|
|
|
|
|
} |
1001
|
|
|
|
|
|
|
} |
1002
|
205
|
|
|
|
|
441
|
return; |
1003
|
|
|
|
|
|
|
} |
1004
|
|
|
|
|
|
|
|
1005
|
|
|
|
|
|
|
# check if a variable should be marked as #unresolved based on right-hand-side of assignment |
1006
|
|
|
|
|
|
|
# |
1007
|
|
|
|
|
|
|
sub is_unresolved_assignment { |
1008
|
1003
|
|
|
1003
|
0
|
1946
|
my ($ctx, $rhs) = @_; |
1009
|
1003
|
|
|
|
|
1708
|
my $parser = $ctx->{parser}; |
1010
|
|
|
|
|
|
|
|
1011
|
1003
|
100
|
|
|
|
2357
|
if ($rhs =~ /^#expr\d+$/) { |
1012
|
54
|
|
|
|
|
125
|
my ($op, $v1, $v2) = @{$parser->{strmap}->{$rhs}}; |
|
54
|
|
|
|
|
181
|
|
1013
|
|
|
|
|
|
|
|
1014
|
54
|
50
|
33
|
|
|
189
|
if (($op eq '=') && defined $v2) { |
1015
|
|
|
|
|
|
|
# check for: $a = $b = 1; |
1016
|
0
|
|
|
|
|
0
|
return $ctx->is_unresolved_assignment($v2); |
1017
|
|
|
|
|
|
|
} |
1018
|
|
|
|
|
|
|
|
1019
|
|
|
|
|
|
|
# expressions should already have been resolved |
1020
|
|
|
|
|
|
|
# (such assignments would lead to recursions like $a = expr:[$a + 1]) |
1021
|
|
|
|
|
|
|
# |
1022
|
54
|
|
|
|
|
153
|
return 1; |
1023
|
|
|
|
|
|
|
} |
1024
|
949
|
|
|
|
|
3818
|
my $info = {vars => {}, calls => {}, stmts => {}}; |
1025
|
949
|
|
|
|
|
3402
|
$parser->stmt_info($rhs, $info); |
1026
|
|
|
|
|
|
|
|
1027
|
949
|
100
|
100
|
|
|
2203
|
if (my $c = _skipped_call($parser, $rhs, '(.*)', $info)) { |
|
|
100
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
1028
|
|
|
|
|
|
|
# never replace content when the rhs contains |
1029
|
|
|
|
|
|
|
# an unresolved #call |
1030
|
|
|
|
|
|
|
# |
1031
|
73
|
|
|
|
|
349
|
return 1; |
1032
|
|
|
|
|
|
|
} elsif (!is_variable($rhs) && !is_flat_elem($rhs, $parser) && $ctx->unresolvable_var($info)) { |
1033
|
|
|
|
|
|
|
# don't replace content when the rhs contains |
1034
|
|
|
|
|
|
|
# a unresolved variable. |
1035
|
|
|
|
|
|
|
# Make an exception for single variables and simple #elems. |
1036
|
|
|
|
|
|
|
# |
1037
|
7
|
|
|
|
|
35
|
return 1; |
1038
|
|
|
|
|
|
|
} elsif (is_variable($rhs)) { |
1039
|
|
|
|
|
|
|
# forward unresolved state to lhs |
1040
|
|
|
|
|
|
|
# |
1041
|
17
|
|
|
|
|
109
|
my $val = $ctx->getvar($rhs, 1); |
1042
|
17
|
100
|
66
|
|
|
134
|
if (defined $val && ($val eq '#unresolved')) { |
1043
|
15
|
|
|
|
|
80
|
return 1; |
1044
|
|
|
|
|
|
|
} |
1045
|
|
|
|
|
|
|
} |
1046
|
854
|
|
|
|
|
4104
|
return 0; |
1047
|
|
|
|
|
|
|
} |
1048
|
|
|
|
|
|
|
|
1049
|
|
|
|
|
|
|
# check if this is pre/post increment expr |
1050
|
|
|
|
|
|
|
# |
1051
|
|
|
|
|
|
|
sub _is_increment_op { |
1052
|
1238
|
|
|
1238
|
|
2100
|
my ($parser, $stmt) = @_; |
1053
|
|
|
|
|
|
|
|
1054
|
1238
|
100
|
|
|
|
2459
|
if ($stmt =~ /^#expr\d+$/) { |
1055
|
50
|
|
|
|
|
81
|
my ($op, $v1, $v2) = @{$parser->{strmap}->{$stmt}}; |
|
50
|
|
|
|
|
170
|
|
1056
|
50
|
|
100
|
|
|
283
|
return ($op eq '++') || ($op eq '--'); |
1057
|
|
|
|
|
|
|
} |
1058
|
1188
|
|
|
|
|
3142
|
return; |
1059
|
|
|
|
|
|
|
} |
1060
|
|
|
|
|
|
|
|
1061
|
|
|
|
|
|
|
# return varable if statement is assignment |
1062
|
|
|
|
|
|
|
# |
1063
|
|
|
|
|
|
|
sub _var_assignment { |
1064
|
2345
|
|
|
2345
|
|
4082
|
my ($parser, $stmt) = @_; |
1065
|
|
|
|
|
|
|
|
1066
|
2345
|
100
|
|
|
|
5922
|
if ($stmt =~ /^#expr\d+$/) { |
1067
|
1120
|
|
|
|
|
1794
|
my ($op, $v1, $v2) = @{$parser->{strmap}->{$stmt}}; |
|
1120
|
|
|
|
|
3084
|
|
1068
|
|
|
|
|
|
|
|
1069
|
1120
|
100
|
66
|
|
|
3936
|
if (($op eq '=') && defined $v2) { |
1070
|
1070
|
|
|
|
|
3941
|
return ($v1, $v2); |
1071
|
|
|
|
|
|
|
} |
1072
|
|
|
|
|
|
|
} |
1073
|
1275
|
|
|
|
|
2404
|
return; |
1074
|
|
|
|
|
|
|
} |
1075
|
|
|
|
|
|
|
|
1076
|
|
|
|
|
|
|
sub get_indexed_array_var { |
1077
|
160
|
|
|
160
|
0
|
294
|
my ($ctx, $var) = @_; |
1078
|
160
|
|
|
|
|
254
|
my $parser = $ctx->{parser}; |
1079
|
|
|
|
|
|
|
|
1080
|
160
|
100
|
|
|
|
345
|
if ($var =~ /^#elem\d+$/) { |
1081
|
50
|
|
|
|
|
76
|
my ($v, $i) = @{$parser->{strmap}->{$var}}; |
|
50
|
|
|
|
|
115
|
|
1082
|
|
|
|
|
|
|
|
1083
|
50
|
|
|
|
|
106
|
my $val = $ctx->getvar($v, 1); |
1084
|
50
|
50
|
33
|
|
|
176
|
if (defined $val && is_array($val)) { |
1085
|
50
|
|
|
|
|
166
|
return ($v, $val); |
1086
|
|
|
|
|
|
|
} |
1087
|
|
|
|
|
|
|
} |
1088
|
110
|
|
|
|
|
223
|
return; |
1089
|
|
|
|
|
|
|
} |
1090
|
|
|
|
|
|
|
|
1091
|
|
|
|
|
|
|
# optimize loop variable assignments |
1092
|
|
|
|
|
|
|
# 1) add block of new instructions from last loop iteration |
1093
|
|
|
|
|
|
|
# 2) merge assignments to same variable or echo-statements |
1094
|
|
|
|
|
|
|
# (just for strval/array values). |
1095
|
|
|
|
|
|
|
# |
1096
|
|
|
|
|
|
|
sub optimize_loop_var_list { |
1097
|
113
|
|
|
113
|
0
|
281
|
my ($ctx, $type, $stmt, $list, $res) = @_; |
1098
|
113
|
|
|
|
|
211
|
my $parser = $ctx->{parser}; |
1099
|
113
|
|
|
|
|
177
|
my $changed = 0; |
1100
|
|
|
|
|
|
|
|
1101
|
113
|
|
|
|
|
252
|
ELEM: for (my $i = 0; $i < scalar @$res; $i++) { |
1102
|
160
|
|
|
|
|
282
|
my $elem = $res->[$i]; |
1103
|
|
|
|
|
|
|
|
1104
|
|
|
|
|
|
|
# merge previous array assignment with new one |
1105
|
|
|
|
|
|
|
# |
1106
|
160
|
|
|
|
|
300
|
my ($v, $lhs) = _var_assignment($parser, $elem); |
1107
|
160
|
100
|
|
|
|
390
|
if (defined $v) { |
1108
|
|
|
|
|
|
|
# optimize only trailing var assignments to strval or array |
1109
|
|
|
|
|
|
|
# |
1110
|
133
|
|
|
|
|
318
|
for (my $j = scalar @$list; $j > 0; $j--) { |
1111
|
167
|
|
|
|
|
310
|
my $prev = $list->[$j-1]; |
1112
|
167
|
|
|
|
|
301
|
my ($vp, $lhsp) = _var_assignment($parser, $prev); |
1113
|
167
|
100
|
|
|
|
376
|
if (!defined $vp) { |
1114
|
10
|
50
|
33
|
|
|
58
|
if (is_strval($prev) || is_array($prev)) { |
|
|
100
|
|
|
|
|
|
1115
|
0
|
|
|
|
|
0
|
next; # allow plain values as statement |
1116
|
|
|
|
|
|
|
} elsif (!_get_echo_arglist($parser, $prev)) { |
1117
|
1
|
|
|
|
|
10
|
push(@$list, $elem); |
1118
|
1
|
|
|
|
|
5
|
next ELEM; # other statements than echo or assign |
1119
|
|
|
|
|
|
|
} else { |
1120
|
9
|
|
|
|
|
23
|
next; |
1121
|
|
|
|
|
|
|
} |
1122
|
|
|
|
|
|
|
} |
1123
|
|
|
|
|
|
|
#$ctx->{log}->($ctx, $type, $stmt, "optimize loop: $v: $prev $vp $lhsp") if $ctx->{log}; |
1124
|
157
|
100
|
100
|
|
|
356
|
unless (is_strval($lhsp) || is_array($lhsp)) { |
1125
|
1
|
|
|
|
|
4
|
push(@$list, $elem); |
1126
|
1
|
|
|
|
|
5
|
next ELEM; # unresolved assignment |
1127
|
|
|
|
|
|
|
} |
1128
|
|
|
|
|
|
|
# substitute: multiple var assignment -> single assigment |
1129
|
|
|
|
|
|
|
# |
1130
|
156
|
100
|
100
|
|
|
394
|
if (is_variable($v) && ($v eq $vp)) { |
1131
|
53
|
50
|
|
|
|
146
|
$ctx->{log}->($ctx, $type, $stmt, "optimize loop: $v [$prev -> $elem]") if $ctx->{log}; |
1132
|
53
|
|
|
|
|
104
|
splice(@$list, $j-1, 1); # remove $prev from list |
1133
|
53
|
|
|
|
|
90
|
$changed = 1; |
1134
|
53
|
|
|
|
|
92
|
push(@$list, $elem); |
1135
|
53
|
|
|
|
|
177
|
next ELEM; |
1136
|
|
|
|
|
|
|
} |
1137
|
|
|
|
|
|
|
|
1138
|
|
|
|
|
|
|
# substitute: multiple array assignment -> single assigment |
1139
|
|
|
|
|
|
|
# |
1140
|
103
|
|
|
|
|
254
|
my ($va, $a) = $ctx->get_indexed_array_var($v); |
1141
|
103
|
100
|
|
|
|
279
|
if (defined $va) { |
1142
|
38
|
100
|
|
|
|
154
|
if ($va eq $vp) { |
1143
|
21
|
|
|
|
|
105
|
my $k = $parser->setexpr('=', $va, $a); |
1144
|
21
|
50
|
|
|
|
81
|
$ctx->{log}->($ctx, $type, $stmt, "optimize loop: $v ($va $a) [$prev, $elem -> $k]") if $ctx->{log}; |
1145
|
21
|
|
|
|
|
43
|
splice(@$list, $j-1, 1); # remove $prev from list |
1146
|
21
|
|
|
|
|
42
|
$res->[$i] = $k; |
1147
|
21
|
|
|
|
|
30
|
$changed = 1; |
1148
|
21
|
|
|
|
|
38
|
push(@$list, $k); |
1149
|
21
|
|
|
|
|
70
|
next ELEM; |
1150
|
|
|
|
|
|
|
} |
1151
|
|
|
|
|
|
|
} |
1152
|
|
|
|
|
|
|
} |
1153
|
|
|
|
|
|
|
# if no variable was found, then substitute new single array elem assigment -> array assignmet |
1154
|
|
|
|
|
|
|
# |
1155
|
57
|
|
|
|
|
130
|
my ($va, $a) = $ctx->get_indexed_array_var($v); |
1156
|
57
|
100
|
|
|
|
134
|
if (defined $va) { |
1157
|
12
|
|
|
|
|
38
|
my $arr = $parser->{strmap}{$a}; |
1158
|
12
|
|
|
|
|
54
|
my $keys = $arr->get_keys(); |
1159
|
12
|
|
|
|
|
25
|
my $size = scalar @$keys; |
1160
|
|
|
|
|
|
|
|
1161
|
|
|
|
|
|
|
# also allow assignment to existing array ($size > 1) |
1162
|
|
|
|
|
|
|
# |
1163
|
12
|
100
|
|
|
|
28
|
if ($size > 1) { |
1164
|
5
|
50
|
|
|
|
23
|
$ctx->{log}->($ctx, $type, $stmt, "optimize loop: initial $va already has elements") if $ctx->{log}; |
1165
|
|
|
|
|
|
|
} |
1166
|
12
|
|
|
|
|
35
|
my $k = $parser->setexpr('=', $va, $a); |
1167
|
12
|
50
|
|
|
|
72
|
$ctx->{log}->($ctx, $type, $stmt, "optimize loop: initial $va ($a size=$size) [$elem -> $k]") if $ctx->{log}; |
1168
|
12
|
|
|
|
|
22
|
$res->[$i] = $k; |
1169
|
12
|
|
|
|
|
22
|
$changed = 1; |
1170
|
12
|
|
|
|
|
21
|
push(@$list, $k); |
1171
|
12
|
|
|
|
|
50
|
next ELEM; |
1172
|
|
|
|
|
|
|
} |
1173
|
|
|
|
|
|
|
} |
1174
|
|
|
|
|
|
|
|
1175
|
|
|
|
|
|
|
# merge previous echo statement with new one |
1176
|
|
|
|
|
|
|
# |
1177
|
72
|
|
|
|
|
195
|
my ($args, $all_str) = _get_echo_arglist($parser, $elem); |
1178
|
72
|
100
|
|
|
|
204
|
if (defined $args) { |
1179
|
21
|
|
|
|
|
53
|
for (my $j = scalar @$list; $j > 0; $j--) { |
1180
|
22
|
|
|
|
|
50
|
my $prev = $list->[$j-1]; |
1181
|
22
|
|
|
|
|
49
|
my ($prev_args, $prev_all_str) = _get_echo_arglist($parser, $prev); |
1182
|
|
|
|
|
|
|
|
1183
|
22
|
100
|
|
|
|
50
|
if (!defined $prev_args) { |
1184
|
12
|
|
|
|
|
29
|
next; |
1185
|
|
|
|
|
|
|
} |
1186
|
10
|
|
|
|
|
23
|
my $k; |
1187
|
10
|
50
|
33
|
|
|
49
|
if ($all_str && $prev_all_str) { |
1188
|
10
|
|
|
|
|
28
|
my $val = join('', map { $parser->{strmap}->{$_} } (@$prev_args, @$args)); |
|
20
|
|
|
|
|
63
|
|
1189
|
10
|
|
|
|
|
34
|
my $str = $parser->setstr($val); |
1190
|
10
|
|
|
|
|
57
|
$k = $parser->setstmt(['echo', [$str]]); |
1191
|
|
|
|
|
|
|
} else { |
1192
|
0
|
|
|
|
|
0
|
$k = $parser->setstmt(['echo', [@$prev_args, @$args]]); |
1193
|
|
|
|
|
|
|
} |
1194
|
10
|
50
|
|
|
|
28
|
$ctx->{log}->($ctx, $type, $stmt, "optimize loop: echo [$prev, $elem -> $k]") if $ctx->{log}; |
1195
|
10
|
|
|
|
|
27
|
splice(@$list, $j-1, 1); # remove $prev from list |
1196
|
10
|
|
|
|
|
28
|
$res->[$i] = $k; |
1197
|
10
|
|
|
|
|
17
|
$changed = 1; |
1198
|
10
|
|
|
|
|
22
|
push(@$list, $k); |
1199
|
10
|
|
|
|
|
32
|
next ELEM; |
1200
|
|
|
|
|
|
|
} |
1201
|
|
|
|
|
|
|
} |
1202
|
62
|
|
|
|
|
171
|
push(@$list, $elem); |
1203
|
|
|
|
|
|
|
} |
1204
|
113
|
|
|
|
|
220
|
return $changed; |
1205
|
|
|
|
|
|
|
} |
1206
|
|
|
|
|
|
|
|
1207
|
|
|
|
|
|
|
sub set_tainted { |
1208
|
236
|
|
|
236
|
0
|
541
|
my ($ctx, $stmt) = @_; |
1209
|
|
|
|
|
|
|
|
1210
|
236
|
100
|
|
|
|
635
|
if ($ctx->{tainted}) { |
1211
|
98
|
|
|
|
|
368
|
$ctx->{warn}->($ctx, 'taint', $stmt, "set ctx tainted"); |
1212
|
|
|
|
|
|
|
} else { |
1213
|
138
|
|
|
|
|
427
|
$ctx->{warn}->($ctx, 'taint', $stmt, "set ctx tainted (untainted before)"); |
1214
|
|
|
|
|
|
|
} |
1215
|
236
|
50
|
|
|
|
13725
|
if (exists $ctx->{with}{invalidate_tainted_vars}) { |
1216
|
0
|
|
|
|
|
0
|
foreach my $k (keys %{$ctx->{globals}}) { |
|
0
|
|
|
|
|
0
|
|
1217
|
0
|
0
|
0
|
|
|
0
|
if (is_variable($k) && !$ctx->is_superglobal($k)) { |
1218
|
0
|
|
|
|
|
0
|
$ctx->{globals}{$k} = '#unresolved'; |
1219
|
|
|
|
|
|
|
} |
1220
|
|
|
|
|
|
|
} |
1221
|
0
|
|
|
|
|
0
|
foreach my $k (keys %{$ctx->{varmap}{global}}) { |
|
0
|
|
|
|
|
0
|
|
1222
|
0
|
0
|
0
|
|
|
0
|
if (is_variable($k) && !$ctx->is_superglobal($k)) { |
1223
|
0
|
|
|
|
|
0
|
$ctx->{globals}{$k} = '#unresolved'; |
1224
|
|
|
|
|
|
|
} |
1225
|
|
|
|
|
|
|
} |
1226
|
|
|
|
|
|
|
} |
1227
|
236
|
|
|
|
|
496
|
$ctx->{tainted} += 1; |
1228
|
236
|
|
|
|
|
570
|
return; |
1229
|
|
|
|
|
|
|
} |
1230
|
|
|
|
|
|
|
|
1231
|
|
|
|
|
|
|
sub set_globals_unresolved { |
1232
|
10
|
|
|
10
|
0
|
27
|
my ($ctx, $list) = @_; |
1233
|
|
|
|
|
|
|
|
1234
|
10
|
|
|
|
|
26
|
foreach my $k (@$list) { |
1235
|
6
|
50
|
33
|
|
|
17
|
if (is_variable($k) && !$ctx->is_superglobal($k)) { |
1236
|
6
|
100
|
100
|
|
|
28
|
if (!exists $ctx->{globals}{$k} || ($ctx->{globals}{$k} ne '#unresolved')) { |
1237
|
5
|
50
|
|
|
|
37
|
$ctx->{log}->($ctx, 'set_unresolved', $k, "(global)") if $ctx->{log}; |
1238
|
5
|
|
|
|
|
16
|
$ctx->{globals}{$k} = '#unresolved'; |
1239
|
|
|
|
|
|
|
} |
1240
|
|
|
|
|
|
|
} |
1241
|
|
|
|
|
|
|
} |
1242
|
10
|
|
|
|
|
27
|
return; |
1243
|
|
|
|
|
|
|
} |
1244
|
|
|
|
|
|
|
|
1245
|
|
|
|
|
|
|
sub set_locals_unresolved { |
1246
|
45
|
|
|
45
|
0
|
124
|
my ($ctx, $list) = @_; |
1247
|
|
|
|
|
|
|
|
1248
|
45
|
|
|
|
|
136
|
foreach my $k (@$list) { |
1249
|
87
|
100
|
66
|
|
|
213
|
if (is_variable($k) && !$ctx->is_superglobal($k)) { |
1250
|
82
|
100
|
100
|
|
|
360
|
if (!exists $ctx->{varmap}{$k} || ($ctx->{varmap}{$k} ne '#unresolved')) { |
1251
|
45
|
50
|
|
|
|
120
|
$ctx->{log}->($ctx, 'set_unresolved', $k, "(local)") if $ctx->{log}; |
1252
|
45
|
|
|
|
|
133
|
$ctx->{varmap}{$k} = '#unresolved'; |
1253
|
|
|
|
|
|
|
} |
1254
|
|
|
|
|
|
|
} |
1255
|
|
|
|
|
|
|
} |
1256
|
45
|
|
|
|
|
131
|
return; |
1257
|
|
|
|
|
|
|
} |
1258
|
|
|
|
|
|
|
|
1259
|
|
|
|
|
|
|
sub set_undefined_globals_unresolved { |
1260
|
12
|
|
|
12
|
0
|
34
|
my ($ctx, $list) = @_; |
1261
|
|
|
|
|
|
|
|
1262
|
12
|
|
|
|
|
39
|
foreach my $k (@$list) { |
1263
|
15
|
50
|
33
|
|
|
47
|
if (is_variable($k) && !$ctx->is_superglobal($k)) { |
1264
|
15
|
100
|
|
|
|
41
|
if (!exists $ctx->{globals}{$k}) { |
1265
|
12
|
50
|
|
|
|
34
|
$ctx->{log}->($ctx, 'set_unresolved', $k, "(undefined global)") if $ctx->{log}; |
1266
|
12
|
|
|
|
|
41
|
$ctx->{globals}{$k} = '#unresolved'; |
1267
|
|
|
|
|
|
|
} |
1268
|
|
|
|
|
|
|
} |
1269
|
|
|
|
|
|
|
} |
1270
|
12
|
|
|
|
|
23
|
return; |
1271
|
|
|
|
|
|
|
} |
1272
|
|
|
|
|
|
|
|
1273
|
|
|
|
|
|
|
sub set_undefined_locals_unresolved { |
1274
|
96
|
|
|
96
|
0
|
315
|
my ($ctx, $list) = @_; |
1275
|
|
|
|
|
|
|
|
1276
|
96
|
|
|
|
|
254
|
foreach my $k (@$list) { |
1277
|
145
|
100
|
66
|
|
|
408
|
if (is_variable($k) && !$ctx->is_superglobal($k)) { |
1278
|
114
|
100
|
|
|
|
387
|
if (!exists $ctx->{varmap}{$k}) { |
1279
|
63
|
100
|
|
|
|
184
|
if (exists $ctx->{varmap}{global}{$k}) { |
1280
|
1
|
50
|
|
|
|
6
|
if (!exists $ctx->{globals}{$k}) { |
1281
|
1
|
50
|
|
|
|
5
|
$ctx->{log}->($ctx, 'set_unresolved', $k, "(undefined local global)") if $ctx->{log}; |
1282
|
1
|
|
|
|
|
5
|
$ctx->{globals}{$k} = '#unresolved'; |
1283
|
|
|
|
|
|
|
} |
1284
|
|
|
|
|
|
|
} else { |
1285
|
62
|
50
|
|
|
|
161
|
$ctx->{log}->($ctx, 'set_unresolved', $k, "(undefined local)") if $ctx->{log}; |
1286
|
62
|
|
|
|
|
223
|
$ctx->{varmap}{$k} = '#unresolved'; |
1287
|
|
|
|
|
|
|
} |
1288
|
|
|
|
|
|
|
} |
1289
|
|
|
|
|
|
|
} |
1290
|
|
|
|
|
|
|
} |
1291
|
96
|
|
|
|
|
241
|
return; |
1292
|
|
|
|
|
|
|
} |
1293
|
|
|
|
|
|
|
|
1294
|
|
|
|
|
|
|
# invalidate all undefined variables so that they do not resolve to '#null'. |
1295
|
|
|
|
|
|
|
# |
1296
|
|
|
|
|
|
|
sub invalidate_undefined_vars { |
1297
|
102
|
|
|
102
|
0
|
250
|
my ($ctx, $info, $type, $stmt) = @_; |
1298
|
|
|
|
|
|
|
|
1299
|
102
|
100
|
|
|
|
150
|
if (keys %{$info->{globals}}) { |
|
102
|
|
|
|
|
397
|
|
1300
|
12
|
|
|
|
|
31
|
$ctx->{warn}->($ctx, $type, $stmt, "unresolve - found globals[%s]", join(' ', keys %{$info->{globals}})); |
|
12
|
|
|
|
|
69
|
|
1301
|
12
|
|
|
|
|
1189
|
$ctx->set_undefined_globals_unresolved([keys %{$info->{globals}}]); |
|
12
|
|
|
|
|
100
|
|
1302
|
|
|
|
|
|
|
} |
1303
|
102
|
100
|
|
|
|
203
|
if (keys %{$info->{vars}}) { |
|
102
|
|
|
|
|
390
|
|
1304
|
96
|
|
66
|
|
|
177
|
my @vars = grep { !exists $info->{globals}{$_} && !exists $info->{unresolved}{$_} } keys %{$info->{vars}}; |
|
146
|
|
|
|
|
755
|
|
|
96
|
|
|
|
|
283
|
|
1305
|
96
|
50
|
|
|
|
273
|
if (@vars) { |
1306
|
96
|
|
|
|
|
515
|
$ctx->{warn}->($ctx, $type, $stmt, "unresolve - found locals[%s]", join(' ', @vars)); |
1307
|
96
|
|
|
|
|
7985
|
$ctx->set_undefined_locals_unresolved(\@vars); |
1308
|
|
|
|
|
|
|
} |
1309
|
|
|
|
|
|
|
} |
1310
|
102
|
|
|
|
|
252
|
return; |
1311
|
|
|
|
|
|
|
} |
1312
|
|
|
|
|
|
|
|
1313
|
|
|
|
|
|
|
# invalidate all variables with dependencies on subsequent calls of same block. |
1314
|
|
|
|
|
|
|
# |
1315
|
|
|
|
|
|
|
sub invalidate_vars { |
1316
|
31
|
|
|
31
|
0
|
89
|
my ($ctx, $info, $type, $stmt) = @_; |
1317
|
|
|
|
|
|
|
|
1318
|
31
|
100
|
|
|
|
56
|
if (keys %{$info->{global_assigns}}) { |
|
31
|
|
|
|
|
152
|
|
1319
|
3
|
|
|
|
|
8
|
$ctx->{warn}->($ctx, $type, $stmt, "unresolve - found global assigns[%s]", join(' ', keys %{$info->{global_assigns}})); |
|
3
|
|
|
|
|
17
|
|
1320
|
3
|
|
|
|
|
141
|
$ctx->set_globals_unresolved([keys %{$info->{global_assigns}}]); |
|
3
|
|
|
|
|
20
|
|
1321
|
|
|
|
|
|
|
} |
1322
|
31
|
100
|
|
|
|
80
|
if (keys %{$info->{local_assigns}}) { |
|
31
|
|
|
|
|
103
|
|
1323
|
28
|
|
|
|
|
56
|
$ctx->{warn}->($ctx, $type, $stmt, "unresolve - found local assigns[%s]", join(' ', keys %{$info->{local_assigns}})); |
|
28
|
|
|
|
|
172
|
|
1324
|
28
|
|
|
|
|
1290
|
$ctx->set_locals_unresolved([keys %{$info->{local_assigns}}]); |
|
28
|
|
|
|
|
234
|
|
1325
|
|
|
|
|
|
|
} |
1326
|
31
|
100
|
|
|
|
64
|
if (keys %{$info->{unresolved}}) { |
|
31
|
|
|
|
|
135
|
|
1327
|
18
|
|
|
|
|
44
|
$ctx->{warn}->($ctx, $type, $stmt, "unresolve - found unresolved[%s]", join(' ', keys %{$info->{unresolved}})); |
|
18
|
|
|
|
|
91
|
|
1328
|
|
|
|
|
|
|
|
1329
|
|
|
|
|
|
|
# TODO: is this necessary with set_tainted()? |
1330
|
|
|
|
|
|
|
# |
1331
|
18
|
100
|
|
|
|
366
|
if (keys %{$info->{globals}}) { |
|
18
|
|
|
|
|
107
|
|
1332
|
2
|
|
|
|
|
16
|
$ctx->{warn}->($ctx, $type, $stmt, "unresolve - found globals[%s]", join(' ', keys %{$info->{globals}})); |
|
2
|
|
|
|
|
22
|
|
1333
|
2
|
|
|
|
|
31
|
$ctx->set_globals_unresolved([keys %{$info->{globals}}]); |
|
2
|
|
|
|
|
40
|
|
1334
|
|
|
|
|
|
|
} |
1335
|
18
|
100
|
|
|
|
46
|
if (keys %{$info->{vars}}) { |
|
18
|
|
|
|
|
72
|
|
1336
|
17
|
|
33
|
|
|
36
|
my @vars = grep { !exists $info->{globals}{$_} && !exists $info->{unresolved}{$_} } keys %{$info->{vars}}; |
|
33
|
|
|
|
|
181
|
|
|
17
|
|
|
|
|
44
|
|
1337
|
17
|
50
|
|
|
|
59
|
if (@vars) { |
1338
|
17
|
|
|
|
|
87
|
$ctx->{warn}->($ctx, $type, $stmt, "unresolve - found locals[%s]", join(' ', @vars)); |
1339
|
17
|
|
|
|
|
316
|
$ctx->set_locals_unresolved(\@vars); |
1340
|
|
|
|
|
|
|
} |
1341
|
|
|
|
|
|
|
} |
1342
|
|
|
|
|
|
|
} |
1343
|
31
|
|
|
|
|
73
|
return; |
1344
|
|
|
|
|
|
|
} |
1345
|
|
|
|
|
|
|
|
1346
|
|
|
|
|
|
|
sub update_unresolved { |
1347
|
172
|
|
|
172
|
0
|
350
|
my ($ctx, $ctx2) = @_; |
1348
|
|
|
|
|
|
|
|
1349
|
|
|
|
|
|
|
# copy unresolved status from ctx2 to ctx |
1350
|
|
|
|
|
|
|
# |
1351
|
172
|
|
|
|
|
261
|
foreach my $k (keys %{$ctx2->{globals}}) { |
|
172
|
|
|
|
|
730
|
|
1352
|
1053
|
100
|
100
|
|
|
2032
|
if (is_variable($k) && !$ctx2->is_superglobal($k)) { |
1353
|
178
|
100
|
66
|
|
|
848
|
if (!exists $ctx->{globals}{$k} || ($ctx->{globals}{$k} ne $ctx2->{globals}{$k})) { |
1354
|
34
|
50
|
|
|
|
125
|
$ctx->{log}->($ctx, 'set_unresolved', $k, "(global) update from clone") if $ctx->{log}; |
1355
|
34
|
|
|
|
|
90
|
$ctx->{globals}{$k} = '#unresolved'; |
1356
|
|
|
|
|
|
|
} |
1357
|
|
|
|
|
|
|
} |
1358
|
|
|
|
|
|
|
} |
1359
|
172
|
|
|
|
|
379
|
foreach my $k (keys %{$ctx2->{varmap}}) { |
|
172
|
|
|
|
|
638
|
|
1360
|
1473
|
100
|
100
|
|
|
2508
|
if (is_variable($k) && !$ctx2->is_superglobal($k)) { |
1361
|
294
|
100
|
66
|
|
|
1174
|
if (!exists $ctx->{varmap}{$k} || ($ctx->{varmap}{$k} ne $ctx2->{varmap}{$k})) { |
1362
|
37
|
50
|
|
|
|
117
|
$ctx->{log}->($ctx, 'set_unresolved', $k, "(local) update from clone") if $ctx->{log}; |
1363
|
37
|
|
|
|
|
115
|
$ctx->{varmap}{$k} = '#unresolved'; |
1364
|
|
|
|
|
|
|
} |
1365
|
|
|
|
|
|
|
} |
1366
|
|
|
|
|
|
|
} |
1367
|
172
|
|
|
|
|
404
|
return; |
1368
|
|
|
|
|
|
|
} |
1369
|
|
|
|
|
|
|
|
1370
|
|
|
|
|
|
|
sub is_superglobal { |
1371
|
6090
|
|
|
6090
|
0
|
10564
|
my ($ctx, $var) = @_; |
1372
|
|
|
|
|
|
|
|
1373
|
6090
|
|
|
|
|
19902
|
return exists $ctx->{superglobal}{$var}; |
1374
|
|
|
|
|
|
|
} |
1375
|
|
|
|
|
|
|
|
1376
|
|
|
|
|
|
|
# check if variable is global in current context |
1377
|
|
|
|
|
|
|
# |
1378
|
|
|
|
|
|
|
sub is_global_var { |
1379
|
20
|
|
|
20
|
0
|
48
|
my ($ctx, $var) = @_; |
1380
|
20
|
|
|
|
|
50
|
my ($g) = global_split($var); |
1381
|
20
|
100
|
|
|
|
70
|
if (defined $g) { |
1382
|
10
|
|
|
|
|
26
|
return $g; # converted $GLOBALS['var'] |
1383
|
|
|
|
|
|
|
} |
1384
|
10
|
50
|
|
|
|
45
|
if (exists $ctx->{varmap}{global}{$var}) { |
1385
|
0
|
|
|
|
|
0
|
return $var; # 'global $var;' |
1386
|
|
|
|
|
|
|
} |
1387
|
10
|
50
|
|
|
|
32
|
unless ($ctx->{infunction}) { |
1388
|
0
|
|
|
|
|
0
|
return $var; # outside of func all vars are global |
1389
|
|
|
|
|
|
|
} |
1390
|
10
|
|
|
|
|
21
|
return; |
1391
|
|
|
|
|
|
|
} |
1392
|
|
|
|
|
|
|
|
1393
|
|
|
|
|
|
|
# check if variable is instance var |
1394
|
|
|
|
|
|
|
# |
1395
|
|
|
|
|
|
|
sub is_instvar { |
1396
|
1856
|
|
|
1856
|
0
|
3252
|
my ($var) = @_; |
1397
|
1856
|
|
|
|
|
4148
|
my ($inst, $instvar) = inst_split($var); |
1398
|
1856
|
100
|
|
|
|
3825
|
if (defined $inst) { |
1399
|
46
|
|
|
|
|
189
|
return ($inst =~ /^#inst\d+$/); |
1400
|
|
|
|
|
|
|
} |
1401
|
1810
|
|
|
|
|
4265
|
return 0; |
1402
|
|
|
|
|
|
|
} |
1403
|
|
|
|
|
|
|
|
1404
|
|
|
|
|
|
|
sub is_inst_or_classvar { |
1405
|
0
|
|
|
0
|
0
|
0
|
my ($var) = @_; |
1406
|
0
|
|
|
|
|
0
|
my ($inst, $instvar) = inst_split($var); |
1407
|
0
|
0
|
|
|
|
0
|
if (defined $inst) { |
1408
|
0
|
|
|
|
|
0
|
return 1; |
1409
|
|
|
|
|
|
|
} |
1410
|
0
|
|
|
|
|
0
|
return 0; |
1411
|
|
|
|
|
|
|
} |
1412
|
|
|
|
|
|
|
|
1413
|
|
|
|
|
|
|
sub setvar { |
1414
|
1160
|
|
|
1160
|
1
|
2328
|
my ($ctx, $var, $val, $in_block) = @_; |
1415
|
1160
|
|
|
|
|
1701
|
my $wasset = 0; |
1416
|
|
|
|
|
|
|
|
1417
|
|
|
|
|
|
|
# set class vars when classes are initialized |
1418
|
|
|
|
|
|
|
# |
1419
|
1160
|
100
|
100
|
|
|
3693
|
if (!$ctx->{infunction} && $ctx->{class_scope}) { |
1420
|
9
|
|
|
|
|
28
|
my ($inst, $instvar) = inst_split($var); |
1421
|
9
|
50
|
33
|
|
|
32
|
if (!defined $inst || ($inst ne 'GLOBALS')) { |
1422
|
9
|
|
|
|
|
31
|
$var = inst_var($ctx->{class_scope}, $var); |
1423
|
|
|
|
|
|
|
} |
1424
|
|
|
|
|
|
|
} |
1425
|
1160
|
|
|
|
|
2640
|
my ($global) = global_split($var); |
1426
|
1160
|
|
|
|
|
2525
|
my ($inst, $instvar) = inst_split($var); |
1427
|
1160
|
100
|
|
|
|
2568
|
$inst = lc($inst) if defined $inst; |
1428
|
|
|
|
|
|
|
|
1429
|
1160
|
100
|
|
|
|
2399
|
if ($ctx->is_superglobal($var)) { |
1430
|
14
|
|
|
|
|
41
|
$global = $var; |
1431
|
|
|
|
|
|
|
} |
1432
|
1160
|
100
|
66
|
|
|
7062
|
if (defined $global) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
1433
|
34
|
50
|
|
|
|
123
|
if (exists $ctx->{globals}) { |
1434
|
34
|
|
|
|
|
87
|
$ctx->{globals}{$global} = $val; |
1435
|
34
|
|
|
|
|
57
|
$wasset = 1; |
1436
|
|
|
|
|
|
|
} |
1437
|
|
|
|
|
|
|
} elsif (exists $ctx->{varmap}{global}{$var}) { |
1438
|
10
|
50
|
|
|
|
42
|
if (exists $ctx->{globals}) { |
1439
|
10
|
|
|
|
|
27
|
$ctx->{globals}{$var} = $val; |
1440
|
10
|
|
|
|
|
28
|
$var = global_var($var); |
1441
|
10
|
|
|
|
|
22
|
$wasset = 1; |
1442
|
|
|
|
|
|
|
} |
1443
|
|
|
|
|
|
|
} elsif (exists $ctx->{varmap}{ref}{$var}) { |
1444
|
6
|
|
|
|
|
13
|
my ($ctx2, $var1) = @{$ctx->{varmap}{ref}{$var}}; |
|
6
|
|
|
|
|
23
|
|
1445
|
6
|
|
|
|
|
21
|
$ctx2->setvar($var1, $val, $in_block); |
1446
|
|
|
|
|
|
|
} elsif (exists $ctx->{varmap}{static}{$ctx->{infunction}}{$var}) { |
1447
|
4
|
100
|
66
|
|
|
19
|
if ($ctx->{infunction} && $ctx->{incall}) { |
1448
|
3
|
|
|
|
|
8
|
$ctx->{varmap}{static}{$ctx->{infunction}}{$var} = $val; |
1449
|
3
|
|
|
|
|
4
|
$wasset = 1; |
1450
|
|
|
|
|
|
|
} else { |
1451
|
1
|
|
|
|
|
13
|
$ctx->{warn}->($ctx, 'setvar', $var, "static not in call"); |
1452
|
|
|
|
|
|
|
} |
1453
|
|
|
|
|
|
|
} elsif (defined $inst && exists $ctx->{varmap}{inst}{$inst}) { |
1454
|
27
|
|
|
|
|
66
|
$ctx->{varmap}{inst}{$inst}{$instvar} = $val; |
1455
|
27
|
|
|
|
|
51
|
$wasset = 1; |
1456
|
|
|
|
|
|
|
} else { |
1457
|
1079
|
|
|
|
|
3032
|
$ctx->{varmap}{$var} = $val; |
1458
|
1079
|
|
|
|
|
1662
|
$wasset = 1; |
1459
|
|
|
|
|
|
|
} |
1460
|
1160
|
100
|
|
|
|
2165
|
if ($wasset) { |
1461
|
1153
|
100
|
|
|
|
2065
|
if (!$in_block) { |
1462
|
192
|
50
|
|
|
|
513
|
$ctx->{log}->($ctx, 'setvar', $var, "= $val [TRACK]") if $ctx->{log}; |
1463
|
192
|
|
|
|
|
534
|
$ctx->track_assignment($var, $val); |
1464
|
|
|
|
|
|
|
} else { |
1465
|
961
|
50
|
|
|
|
1936
|
$ctx->{log}->($ctx, 'setvar', $var, "= $val") if $ctx->{log}; |
1466
|
|
|
|
|
|
|
} |
1467
|
|
|
|
|
|
|
} |
1468
|
1160
|
|
|
|
|
2111
|
return; |
1469
|
|
|
|
|
|
|
} |
1470
|
|
|
|
|
|
|
|
1471
|
|
|
|
|
|
|
sub add_namespace { |
1472
|
896
|
|
|
896
|
0
|
1652
|
my ($ctx, $name) = @_; |
1473
|
|
|
|
|
|
|
|
1474
|
896
|
100
|
|
|
|
2832
|
if ($name =~ /^\\(.*)$/) { |
|
|
100
|
|
|
|
|
|
1475
|
3
|
|
|
|
|
10
|
$name = $1; # remove absolute |
1476
|
|
|
|
|
|
|
} elsif ($ctx->{namespace}) { |
1477
|
7
|
|
|
|
|
41
|
$name = ns_name(lc($ctx->{namespace}), $name); # relative |
1478
|
|
|
|
|
|
|
} |
1479
|
896
|
|
|
|
|
2018
|
return $name; |
1480
|
|
|
|
|
|
|
} |
1481
|
|
|
|
|
|
|
|
1482
|
|
|
|
|
|
|
# function and class names are case-insensitive |
1483
|
|
|
|
|
|
|
# https://www.php.net/manual/en/functions.user-defined.php |
1484
|
|
|
|
|
|
|
# |
1485
|
|
|
|
|
|
|
sub registerfun { |
1486
|
296
|
|
|
296
|
1
|
599
|
my ($ctx, $name, $f) = @_; |
1487
|
|
|
|
|
|
|
|
1488
|
|
|
|
|
|
|
# functions are always global, but locally defined functions |
1489
|
|
|
|
|
|
|
# are temporarily registered in the local varmap if a function |
1490
|
|
|
|
|
|
|
# is simplified (see: subglobctx). |
1491
|
|
|
|
|
|
|
# |
1492
|
296
|
100
|
|
|
|
583
|
if (exists $ctx->{class_scope}) { |
1493
|
62
|
|
|
|
|
222
|
$name = method_name($ctx->{class_scope}, lc($name)); |
1494
|
|
|
|
|
|
|
} else { |
1495
|
234
|
|
|
|
|
431
|
$name = lc($name); # functions are not case-sensitive |
1496
|
|
|
|
|
|
|
} |
1497
|
296
|
100
|
|
|
|
684
|
if ($ctx->{namespace}) { |
1498
|
6
|
|
|
|
|
27
|
$name = ns_name(lc($ctx->{namespace}), $name); |
1499
|
|
|
|
|
|
|
} |
1500
|
296
|
100
|
|
|
|
565
|
if ($ctx->{infunction}) { |
1501
|
9
|
|
|
|
|
27
|
$ctx->{varmap}{fun}{$name} = $f; |
1502
|
|
|
|
|
|
|
} else { |
1503
|
287
|
|
|
|
|
722
|
$ctx->{globals}{fun}{$name} = $f; |
1504
|
|
|
|
|
|
|
} |
1505
|
296
|
50
|
|
|
|
610
|
$ctx->{log}->($ctx, 'registerfun', $name, "$f") if $ctx->{log}; |
1506
|
296
|
|
|
|
|
787
|
return; |
1507
|
|
|
|
|
|
|
} |
1508
|
|
|
|
|
|
|
|
1509
|
|
|
|
|
|
|
# lookup method name by instance name |
1510
|
|
|
|
|
|
|
# |
1511
|
|
|
|
|
|
|
sub lookup_method_name { |
1512
|
1217
|
|
|
1217
|
0
|
2033
|
my ($ctx, $name) = @_; |
1513
|
|
|
|
|
|
|
|
1514
|
1217
|
|
|
|
|
1745
|
$name = lc($name); # functions are not case-sensitive |
1515
|
|
|
|
|
|
|
|
1516
|
1217
|
|
|
|
|
3120
|
my ($inst, $prop) = method_split($name); |
1517
|
|
|
|
|
|
|
|
1518
|
1217
|
100
|
|
|
|
2648
|
if (defined $inst) { |
1519
|
196
|
100
|
100
|
|
|
806
|
if (exists $ctx->{varmap}{inst}{$inst} && exists $ctx->{varmap}{inst}{$inst}{$prop}) { |
1520
|
60
|
|
|
|
|
121
|
my $method = $ctx->{varmap}{inst}{$inst}{$prop}; # lookup instance function |
1521
|
60
|
|
|
|
|
166
|
return $method; |
1522
|
|
|
|
|
|
|
} |
1523
|
|
|
|
|
|
|
} |
1524
|
1157
|
|
|
|
|
3257
|
return; |
1525
|
|
|
|
|
|
|
} |
1526
|
|
|
|
|
|
|
|
1527
|
|
|
|
|
|
|
sub getfun { |
1528
|
1157
|
|
|
1157
|
1
|
2252
|
my ($ctx, $name) = @_; |
1529
|
|
|
|
|
|
|
|
1530
|
1157
|
|
|
|
|
1997
|
$name = lc($name); # functions are not case-sensitive |
1531
|
|
|
|
|
|
|
|
1532
|
1157
|
100
|
|
|
|
2551
|
if (my $method = $ctx->lookup_method_name($name)) { |
|
|
100
|
|
|
|
|
|
1533
|
30
|
|
|
|
|
54
|
$name = $method; |
1534
|
|
|
|
|
|
|
} elsif (exists $ctx->{class_scope}) { |
1535
|
59
|
|
|
|
|
170
|
my $method = lc(method_name($ctx->{class_scope}, $name)); |
1536
|
59
|
100
|
|
|
|
211
|
if (exists $ctx->{globals}{fun}{$method}) { |
|
|
50
|
|
|
|
|
|
1537
|
31
|
|
|
|
|
278
|
return $ctx->{globals}{fun}{$method}; |
1538
|
|
|
|
|
|
|
} elsif (exists $ctx->{varmap}{fun}{$method}) { |
1539
|
0
|
|
|
|
|
0
|
return $ctx->{varmap}{fun}{$method}; |
1540
|
|
|
|
|
|
|
} |
1541
|
|
|
|
|
|
|
} |
1542
|
1126
|
100
|
|
|
|
3454
|
if (exists $ctx->{globals}{fun}{$name}) { |
|
|
100
|
|
|
|
|
|
1543
|
341
|
|
|
|
|
1808
|
return $ctx->{globals}{fun}{$name}; |
1544
|
|
|
|
|
|
|
} elsif (exists $ctx->{varmap}{fun}{$name}) { |
1545
|
4
|
|
|
|
|
38
|
return $ctx->{varmap}{fun}{$name}; |
1546
|
|
|
|
|
|
|
} |
1547
|
781
|
|
|
|
|
1369
|
return; |
1548
|
|
|
|
|
|
|
} |
1549
|
|
|
|
|
|
|
|
1550
|
|
|
|
|
|
|
sub registerclass { |
1551
|
68
|
|
|
68
|
1
|
151
|
my ($ctx, $name, $c) = @_; |
1552
|
|
|
|
|
|
|
|
1553
|
68
|
|
|
|
|
128
|
$name = lc($name); |
1554
|
|
|
|
|
|
|
|
1555
|
68
|
100
|
|
|
|
145
|
if ($ctx->{namespace}) { |
1556
|
1
|
|
|
|
|
8
|
$name = ns_name(lc($ctx->{namespace}), $name); |
1557
|
|
|
|
|
|
|
} |
1558
|
68
|
100
|
|
|
|
141
|
if ($ctx->{infunction}) { |
1559
|
2
|
|
|
|
|
15
|
$ctx->{varmap}{class}{$name} = $c; |
1560
|
|
|
|
|
|
|
} else { |
1561
|
66
|
|
|
|
|
173
|
$ctx->{globals}{class}{$name} = $c; |
1562
|
|
|
|
|
|
|
} |
1563
|
68
|
50
|
|
|
|
138
|
$ctx->{log}->($ctx, 'registerclass', $name, "$c") if $ctx->{log}; |
1564
|
68
|
|
|
|
|
141
|
return; |
1565
|
|
|
|
|
|
|
} |
1566
|
|
|
|
|
|
|
|
1567
|
|
|
|
|
|
|
sub getclass { |
1568
|
136
|
|
|
136
|
1
|
274
|
my ($ctx, $name) = @_; |
1569
|
|
|
|
|
|
|
|
1570
|
136
|
|
|
|
|
211
|
$name = lc($name); |
1571
|
|
|
|
|
|
|
|
1572
|
136
|
100
|
|
|
|
339
|
if (exists $ctx->{globals}{class}{$name}) { |
|
|
100
|
|
|
|
|
|
1573
|
126
|
|
|
|
|
362
|
return $ctx->{globals}{class}{$name}; |
1574
|
|
|
|
|
|
|
} elsif (exists $ctx->{varmap}{class}{$name}) { |
1575
|
1
|
|
|
|
|
14
|
return $ctx->{varmap}{class}{$name}; |
1576
|
|
|
|
|
|
|
} |
1577
|
9
|
|
|
|
|
23
|
return; |
1578
|
|
|
|
|
|
|
} |
1579
|
|
|
|
|
|
|
|
1580
|
|
|
|
|
|
|
sub getvar { |
1581
|
2031
|
|
|
2031
|
1
|
3949
|
my ($ctx, $var, $quiet) = @_; |
1582
|
|
|
|
|
|
|
|
1583
|
|
|
|
|
|
|
# variable names are case sensitive |
1584
|
|
|
|
|
|
|
# |
1585
|
2031
|
|
|
|
|
4855
|
my ($global) = global_split($var); |
1586
|
2031
|
|
|
|
|
4460
|
my ($inst, $instvar) = inst_split($var); |
1587
|
2031
|
100
|
|
|
|
4253
|
$inst = lc($inst) if defined $inst; |
1588
|
|
|
|
|
|
|
|
1589
|
2031
|
100
|
|
|
|
4516
|
if ($ctx->is_superglobal($var)) { |
1590
|
273
|
|
|
|
|
538
|
$global = $var; |
1591
|
|
|
|
|
|
|
} |
1592
|
2031
|
100
|
66
|
|
|
11749
|
if (defined $global) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
1593
|
331
|
50
|
|
|
|
800
|
if (exists $ctx->{globals}) { |
1594
|
331
|
100
|
|
|
|
776
|
if (exists $ctx->{globals}{$global}) { |
1595
|
43
|
|
|
|
|
110
|
my $val = $ctx->{globals}{$global}; |
1596
|
43
|
|
|
|
|
112
|
return $val; |
1597
|
|
|
|
|
|
|
} |
1598
|
288
|
100
|
|
|
|
607
|
if (!$ctx->is_superglobal($var)) { |
1599
|
31
|
50
|
66
|
|
|
151
|
if ($ctx->{incall} || !(exists $ctx->{skip}{null})) { |
1600
|
31
|
100
|
|
|
|
92
|
unless ($ctx->{tainted}) { |
1601
|
5
|
50
|
|
|
|
27
|
$ctx->{warn}->($ctx, 'getvar', $var, "global not found -> #null") unless $quiet; |
1602
|
5
|
|
|
|
|
318
|
return '#null'; |
1603
|
|
|
|
|
|
|
} |
1604
|
|
|
|
|
|
|
} |
1605
|
|
|
|
|
|
|
} |
1606
|
283
|
100
|
|
|
|
1102
|
$ctx->{warn}->($ctx, 'getvar', $var, "global not found") unless $quiet; |
1607
|
|
|
|
|
|
|
} |
1608
|
|
|
|
|
|
|
} elsif (exists $ctx->{varmap}{global}{$var}) { |
1609
|
14
|
50
|
|
|
|
47
|
if (exists $ctx->{globals}) { |
1610
|
14
|
100
|
|
|
|
42
|
if (exists $ctx->{globals}{$var}) { |
1611
|
9
|
|
|
|
|
19
|
my $val = $ctx->{globals}{$var}; |
1612
|
9
|
|
|
|
|
26
|
return $val; |
1613
|
|
|
|
|
|
|
} |
1614
|
5
|
50
|
|
|
|
32
|
$ctx->{warn}->($ctx, 'getvar', $var, "global not found") unless $quiet; |
1615
|
|
|
|
|
|
|
} |
1616
|
|
|
|
|
|
|
} elsif (exists $ctx->{varmap}{ref}{$var}) { |
1617
|
3
|
|
|
|
|
13
|
my ($ctx2, $var1) = @{$ctx->{varmap}{ref}{$var}}; |
|
3
|
|
|
|
|
17
|
|
1618
|
3
|
|
|
|
|
29
|
return $ctx2->getvar($var1, $quiet); |
1619
|
|
|
|
|
|
|
} elsif (exists $ctx->{varmap}{static}{$ctx->{infunction}}{$var}) { |
1620
|
13
|
100
|
66
|
|
|
57
|
if ($ctx->{infunction} && $ctx->{incall}) { |
1621
|
9
|
|
|
|
|
20
|
my $val = $ctx->{varmap}{static}{$ctx->{infunction}}{$var}; |
1622
|
9
|
100
|
|
|
|
20
|
if (!defined $val) { |
1623
|
1
|
|
|
|
|
3
|
return '#null'; |
1624
|
|
|
|
|
|
|
} |
1625
|
8
|
|
|
|
|
20
|
return $val; |
1626
|
|
|
|
|
|
|
} |
1627
|
4
|
50
|
|
|
|
17
|
$ctx->{warn}->($ctx, 'getvar', $var, "static not in call") unless $quiet; |
1628
|
|
|
|
|
|
|
} elsif (defined $inst && exists $ctx->{varmap}{inst}{$inst}) { |
1629
|
45
|
100
|
33
|
|
|
128
|
if (exists $ctx->{varmap}{inst}{$inst}{$instvar}) { |
|
|
50
|
|
|
|
|
|
1630
|
40
|
|
|
|
|
86
|
my $val = $ctx->{varmap}{inst}{$inst}{$instvar}; |
1631
|
40
|
100
|
|
|
|
106
|
if (!defined $val) { |
1632
|
5
|
|
|
|
|
11
|
return '#null'; |
1633
|
|
|
|
|
|
|
} |
1634
|
35
|
|
|
|
|
82
|
return $val; |
1635
|
|
|
|
|
|
|
} elsif (exists $ctx->{class_scope} && $ctx->{varmap}{inst}{$ctx->{class_scope}}{$instvar}) { |
1636
|
0
|
0
|
|
|
|
0
|
$ctx->{log}->($ctx, 'getvar', $var, "class $ctx->{class_scope}") if $ctx->{log}; |
1637
|
0
|
|
|
|
|
0
|
my $val = $ctx->{varmap}{inst}{$ctx->{class_scope}}{$instvar}; |
1638
|
0
|
0
|
|
|
|
0
|
if (!defined $val) { |
1639
|
0
|
|
|
|
|
0
|
return '#null'; |
1640
|
|
|
|
|
|
|
} |
1641
|
0
|
|
|
|
|
0
|
return $val; |
1642
|
|
|
|
|
|
|
} |
1643
|
5
|
50
|
33
|
|
|
35
|
if ($ctx->{incall} || !(exists $ctx->{skip}{null})) { |
1644
|
5
|
100
|
|
|
|
15
|
if (!$ctx->{tainted}) { |
1645
|
3
|
50
|
|
|
|
20
|
$ctx->{warn}->($ctx, 'getvar', $var, "instvar $instvar not found -> #null") unless $quiet; |
1646
|
3
|
|
|
|
|
151
|
return '#null'; |
1647
|
|
|
|
|
|
|
} |
1648
|
|
|
|
|
|
|
} |
1649
|
2
|
50
|
|
|
|
19
|
$ctx->{warn}->($ctx, 'getvar', $var, "instvar $instvar not found") unless $quiet; |
1650
|
|
|
|
|
|
|
} elsif (exists $ctx->{varmap}{$var}) { |
1651
|
1387
|
|
|
|
|
2811
|
my $val = $ctx->{varmap}{$var}; |
1652
|
1387
|
|
|
|
|
3174
|
return $val; |
1653
|
|
|
|
|
|
|
} else { |
1654
|
|
|
|
|
|
|
# if the program is executed and the variable ist not a superglobal, |
1655
|
|
|
|
|
|
|
# then the default val for undefined vars is null: |
1656
|
|
|
|
|
|
|
# https://php.net/manual/en/language.types.null.php |
1657
|
|
|
|
|
|
|
# |
1658
|
|
|
|
|
|
|
# - with E_NOTICE php warn 'Undefined Variable' |
1659
|
|
|
|
|
|
|
# - in arithmetic operations an undefined var is 0 |
1660
|
|
|
|
|
|
|
# |
1661
|
238
|
50
|
66
|
|
|
1108
|
if ($ctx->{incall} || !(exists $ctx->{skip}{null})) { |
1662
|
238
|
100
|
|
|
|
638
|
if (!$ctx->{tainted}) { |
1663
|
149
|
100
|
|
|
|
673
|
$ctx->{warn}->($ctx, 'getvar', $var, "not found -> #null") unless $quiet; |
1664
|
149
|
|
|
|
|
14859
|
return '#null'; |
1665
|
|
|
|
|
|
|
} |
1666
|
|
|
|
|
|
|
} |
1667
|
89
|
100
|
|
|
|
431
|
$ctx->{warn}->($ctx, 'getvar', $var, "not found") unless $quiet; |
1668
|
|
|
|
|
|
|
} |
1669
|
383
|
|
|
|
|
32692
|
return; |
1670
|
|
|
|
|
|
|
} |
1671
|
|
|
|
|
|
|
|
1672
|
|
|
|
|
|
|
# remove local variable assignments from block if variable is otherwise unused |
1673
|
|
|
|
|
|
|
# |
1674
|
|
|
|
|
|
|
sub eliminate_local_assigments { |
1675
|
207
|
|
|
207
|
0
|
539
|
my ($ctx, $info, $code) = @_; |
1676
|
207
|
|
|
|
|
440
|
my $parser = $ctx->{parser}; |
1677
|
|
|
|
|
|
|
|
1678
|
207
|
100
|
|
|
|
806
|
$info->{remaining_locals} = {} unless exists $info->{remaining_locals}; |
1679
|
207
|
100
|
|
|
|
574
|
$info->{remaining_statics} = {} unless exists $info->{remaining_statics}; |
1680
|
|
|
|
|
|
|
|
1681
|
|
|
|
|
|
|
my $out = $parser->map_stmt($code, sub { |
1682
|
845
|
|
|
845
|
|
1473
|
my ($s) = @_; |
1683
|
|
|
|
|
|
|
|
1684
|
845
|
100
|
|
|
|
3173
|
if ($s =~ /^#expr\d+$/) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
1685
|
|
|
|
|
|
|
# $var = |
1686
|
111
|
|
|
|
|
169
|
my ($op, $v1, $v2) = @{$parser->{strmap}->{$s}}; |
|
111
|
|
|
|
|
379
|
|
1687
|
111
|
100
|
100
|
|
|
496
|
if (($op eq '=') && is_variable($v1)) { |
|
|
100
|
100
|
|
|
|
|
1688
|
97
|
|
|
|
|
314
|
my ($inst, $instvar) = inst_split($v1); |
1689
|
|
|
|
|
|
|
|
1690
|
|
|
|
|
|
|
# note: class functions are inititialized without {inst}-map, |
1691
|
|
|
|
|
|
|
# so don't check for class-var existence here. |
1692
|
|
|
|
|
|
|
# |
1693
|
97
|
50
|
100
|
|
|
344
|
if ($ctx->is_superglobal($v1)) { |
|
|
100
|
33
|
|
|
|
|
|
|
100
|
66
|
|
|
|
|
|
|
100
|
33
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
1694
|
0
|
0
|
|
|
|
0
|
$ctx->{log}->($ctx, 'eliminate', $code, "assignment: keep superglobal $v1") if $ctx->{log}; |
1695
|
|
|
|
|
|
|
} elsif (exists $ctx->{varmap}{ref}{$v1}) { |
1696
|
3
|
50
|
|
|
|
12
|
$ctx->{log}->($ctx, 'eliminate', $code, "assignment: keep ref var $v1") if $ctx->{log}; |
1697
|
3
|
|
|
|
|
8
|
$info->{remaining_locals}{$v1} = 1; # XXX |
1698
|
|
|
|
|
|
|
} elsif (exists $ctx->{varmap}{global}{$v1}) { |
1699
|
4
|
|
|
|
|
12
|
my $vv1 = global_var($v1); # convert to explicit global |
1700
|
4
|
|
|
|
|
17
|
my $vv2 = $ctx->eliminate_local_assigments($info, $v2); |
1701
|
4
|
50
|
|
|
|
23
|
$ctx->{log}->($ctx, 'eliminate', $code, "assignment: convert global var $v1=$v2 -> $vv1=$vv2") if $ctx->{log}; |
1702
|
4
|
|
|
|
|
11
|
$info->{global_assigns}{$v1} = 1; |
1703
|
4
|
|
|
|
|
19
|
my $k = $parser->setexpr('=', $vv1, $vv2); |
1704
|
4
|
|
|
|
|
14
|
return $k; |
1705
|
|
|
|
|
|
|
} elsif (defined $inst && ($inst eq 'GLOBALS')) { |
1706
|
6
|
50
|
|
|
|
45
|
$ctx->{log}->($ctx, 'eliminate', $code, "assignment: keep global var $v1") if $ctx->{log}; |
1707
|
|
|
|
|
|
|
} elsif ($ctx->{infunction} && exists $ctx->{varmap}{static}{$ctx->{infunction}}{$v1}) { |
1708
|
3
|
50
|
|
|
|
8
|
$ctx->{log}->($ctx, 'eliminate', $code, "assignment: keep static func var $v1") if $ctx->{log}; |
1709
|
3
|
|
|
|
|
9
|
$info->{remaining_statics}{$v1} = 1; |
1710
|
|
|
|
|
|
|
} elsif (defined $inst && exists $ctx->{class_scope} && (lc($inst) eq $ctx->{class_scope})) { |
1711
|
12
|
50
|
|
|
|
30
|
$ctx->{log}->($ctx, 'eliminate', $code, "assignment: keep static class var $v1") if $ctx->{log}; |
1712
|
12
|
|
|
|
|
33
|
$info->{remaining_statics}{$v1} = 1; |
1713
|
12
|
|
|
|
|
28
|
delete $info->{local_assigns}{$v1}; |
1714
|
|
|
|
|
|
|
} elsif (exists $info->{local_assigns}{$v1}) { |
1715
|
69
|
100
|
66
|
|
|
235
|
if (exists $info->{noassigns}{$v1}) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
1716
|
3
|
50
|
|
|
|
15
|
$ctx->{log}->($ctx, 'eliminate', $code, "assignment $s: remaining local var $v1") if $ctx->{log}; |
1717
|
3
|
|
|
|
|
11
|
$info->{remaining_locals}{$v1} = 1; |
1718
|
|
|
|
|
|
|
} elsif (is_strval($v2)) { |
1719
|
13
|
50
|
|
|
|
44
|
$ctx->{log}->($ctx, 'eliminate', $code, "assignment $s: local var $v1=$v2 -> []") if $ctx->{log}; |
1720
|
13
|
|
|
|
|
43
|
my $empty = $parser->setblk('flat', []); |
1721
|
13
|
|
|
|
|
45
|
return $empty; |
1722
|
|
|
|
|
|
|
} elsif (is_array($v2) && PHP::Decode::Op::array_is_const($parser, $v2)) { |
1723
|
50
|
50
|
|
|
|
144
|
$ctx->{log}->($ctx, 'eliminate', $code, "assignment $s: local var $v1=$v2 -> []") if $ctx->{log}; |
1724
|
50
|
|
|
|
|
148
|
my $empty = $parser->setblk('flat', []); |
1725
|
50
|
|
|
|
|
170
|
return $empty; |
1726
|
|
|
|
|
|
|
} elsif (is_variable($v2)) { |
1727
|
2
|
50
|
|
|
|
7
|
$ctx->{log}->($ctx, 'eliminate', $code, "assignment $s: local var $v1=$v2 -> []") if $ctx->{log}; |
1728
|
2
|
|
|
|
|
6
|
my $empty = $parser->setblk('flat', []); |
1729
|
2
|
|
|
|
|
7
|
return $empty; |
1730
|
|
|
|
|
|
|
} else { |
1731
|
1
|
|
|
|
|
17
|
my $vv2 = $ctx->eliminate_local_assigments($info, $v2); |
1732
|
1
|
50
|
|
|
|
9
|
$ctx->{log}->($ctx, 'eliminate', $code, "assignment $s: local var $v1=$v2 -> $vv2") if $ctx->{log}; |
1733
|
1
|
|
|
|
|
5
|
return $vv2; |
1734
|
|
|
|
|
|
|
} |
1735
|
|
|
|
|
|
|
} else { |
1736
|
0
|
0
|
|
|
|
0
|
$ctx->{log}->($ctx, 'eliminate', $code, "assignment $s: remaining unknown var $v1") if $ctx->{log}; |
1737
|
0
|
|
|
|
|
0
|
$info->{remaining_locals}{$v1} = 1; |
1738
|
|
|
|
|
|
|
} |
1739
|
|
|
|
|
|
|
} elsif (($op eq '=') && ($v1 =~ /^#elem\d+$/)) { |
1740
|
3
|
|
|
|
|
11
|
my $elemlist = _get_elemlist($parser, $v1); |
1741
|
3
|
|
|
|
|
7
|
my ($v, $i) = @{$parser->{strmap}->{$elemlist->[0]}}; |
|
3
|
|
|
|
|
31
|
|
1742
|
3
|
50
|
|
|
|
17
|
if ($v =~ /^\$GLOBALS$/) { |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
1743
|
0
|
0
|
|
|
|
0
|
$ctx->{log}->($ctx, 'eliminate', $code, "assignment: keep global elem $v1") if $ctx->{log}; |
1744
|
|
|
|
|
|
|
} elsif ($ctx->is_superglobal($v)) { |
1745
|
1
|
50
|
|
|
|
6
|
$ctx->{log}->($ctx, 'eliminate', $code, "assignment: keep superglobal elem $v1") if $ctx->{log}; |
1746
|
|
|
|
|
|
|
} elsif (exists $info->{noassigns}{$v}) { |
1747
|
0
|
0
|
|
|
|
0
|
$ctx->{log}->($ctx, 'eliminate', $code, "assignment $s: remaining local elem $v1") if $ctx->{log}; |
1748
|
0
|
|
|
|
|
0
|
$info->{remaining_locals}{$v} = 1; |
1749
|
|
|
|
|
|
|
} elsif (is_variable($v)) { |
1750
|
2
|
50
|
|
|
|
13
|
$ctx->{log}->($ctx, 'eliminate', $code, "assignment $s: local elem $v1=$v2 -> []") if $ctx->{log}; |
1751
|
2
|
|
|
|
|
10
|
my $empty = $parser->setblk('flat', []); |
1752
|
2
|
|
|
|
|
10
|
return $empty; |
1753
|
|
|
|
|
|
|
} else { |
1754
|
0
|
0
|
|
|
|
0
|
$ctx->{log}->($ctx, 'eliminate', $code, "assignment $s: remaining unknown elem $v1") if $ctx->{log}; |
1755
|
0
|
|
|
|
|
0
|
$info->{remaining_locals}{$v} = 1; |
1756
|
|
|
|
|
|
|
} |
1757
|
|
|
|
|
|
|
} |
1758
|
|
|
|
|
|
|
} elsif ($s =~ /^#obj\d+$/) { |
1759
|
4
|
|
|
|
|
25
|
my ($o, $m) = @{$parser->{strmap}->{$s}}; |
|
4
|
|
|
|
|
13
|
|
1760
|
4
|
50
|
|
|
|
25
|
if (lc($o) eq '$this') { |
1761
|
4
|
|
|
|
|
14
|
$info->{remaining_statics}{$s} = 1; # XXX |
1762
|
|
|
|
|
|
|
} else { |
1763
|
0
|
|
|
|
|
0
|
$info->{remaining_locals}{$s} = 1; |
1764
|
|
|
|
|
|
|
} |
1765
|
4
|
50
|
|
|
|
17
|
$ctx->{log}->($ctx, 'eliminate', $code, "keep obj $s") if $ctx->{log}; |
1766
|
|
|
|
|
|
|
} elsif ($s =~ /^#stmt\d+$/) { |
1767
|
180
|
|
|
|
|
447
|
my $cmd = $parser->{strmap}->{$s}->[0]; |
1768
|
180
|
100
|
|
|
|
565
|
if ($cmd eq 'static') { |
|
|
100
|
|
|
|
|
|
1769
|
4
|
|
|
|
|
7
|
my $arglist = $parser->{strmap}->{$s}->[1]; |
1770
|
4
|
|
|
|
|
10
|
foreach my $v (@$arglist) { |
1771
|
4
|
100
|
|
|
|
9
|
if ($v =~ /^#expr\d+$/) { |
1772
|
2
|
50
|
|
|
|
10
|
$ctx->{log}->($ctx, 'eliminate', $code, "$v from static assignment $s") if $ctx->{log}; |
1773
|
|
|
|
|
|
|
} else { |
1774
|
2
|
50
|
|
|
|
9
|
$ctx->{log}->($ctx, 'eliminate', $code, "$v from static definition $s") if $ctx->{log}; |
1775
|
|
|
|
|
|
|
} |
1776
|
|
|
|
|
|
|
} |
1777
|
4
|
|
|
|
|
14
|
my $empty = $parser->setblk('flat', []); |
1778
|
4
|
|
|
|
|
12
|
return $empty; |
1779
|
|
|
|
|
|
|
} elsif ($cmd eq 'global') { |
1780
|
4
|
|
|
|
|
10
|
my $arglist = $parser->{strmap}->{$s}->[1]; |
1781
|
4
|
|
|
|
|
14
|
return $s; # keep variables in global statement as is |
1782
|
|
|
|
|
|
|
} |
1783
|
|
|
|
|
|
|
} elsif (is_variable($s)) { |
1784
|
57
|
|
|
|
|
155
|
my ($inst, $instvar) = inst_split($s); |
1785
|
|
|
|
|
|
|
|
1786
|
57
|
100
|
100
|
|
|
144
|
if ($ctx->is_superglobal($s)) { |
|
|
100
|
33
|
|
|
|
|
|
|
50
|
66
|
|
|
|
|
|
|
100
|
33
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
1787
|
10
|
50
|
|
|
|
32
|
$ctx->{log}->($ctx, 'eliminate', $code, "keep superglobal $s") if $ctx->{log}; |
1788
|
|
|
|
|
|
|
} elsif (exists $ctx->{varmap}{ref}{$s}) { |
1789
|
3
|
50
|
|
|
|
8
|
$ctx->{log}->($ctx, 'eliminate', $code, "keep ref var $s") if $ctx->{log}; |
1790
|
3
|
|
|
|
|
6
|
$info->{remaining_locals}{$s} = 1; # XXX |
1791
|
|
|
|
|
|
|
} elsif (exists $ctx->{varmap}{global}{$s}) { |
1792
|
0
|
|
|
|
|
0
|
my $v = global_var($s); # convert to explicit global |
1793
|
0
|
0
|
|
|
|
0
|
$ctx->{log}->($ctx, 'eliminate', $code, "convert global var $s -> $v") if $ctx->{log}; |
1794
|
0
|
|
|
|
|
0
|
return $v; |
1795
|
|
|
|
|
|
|
} elsif (defined $inst && ($inst eq 'GLOBALS')) { |
1796
|
9
|
50
|
|
|
|
24
|
$ctx->{log}->($ctx, 'eliminate', $code, "keep global var $s") if $ctx->{log}; |
1797
|
|
|
|
|
|
|
} elsif ($ctx->{infunction} && exists $ctx->{varmap}{static}{$ctx->{infunction}}{$s}) { |
1798
|
3
|
50
|
|
|
|
9
|
$ctx->{log}->($ctx, 'eliminate', $code, "is static func var $s") if $ctx->{log}; |
1799
|
3
|
|
|
|
|
16
|
$info->{remaining_statics}{$s} = 1; |
1800
|
|
|
|
|
|
|
} elsif (defined $inst && exists $ctx->{class_scope} && (lc($inst) eq $ctx->{class_scope})) { |
1801
|
16
|
50
|
|
|
|
41
|
$ctx->{log}->($ctx, 'eliminate', $code, "keep static class var $s") if $ctx->{log}; |
1802
|
16
|
|
|
|
|
35
|
$info->{remaining_statics}{$s} = 1; |
1803
|
|
|
|
|
|
|
} elsif (exists $info->{vars}{$s}) { |
1804
|
12
|
50
|
|
|
|
33
|
if (lc($s) eq '$this') { |
1805
|
0
|
0
|
|
|
|
0
|
$ctx->{log}->($ctx, 'eliminate', $code, "remaining local static var $s") if $ctx->{log}; |
1806
|
0
|
|
|
|
|
0
|
$info->{remaining_statics}{$s} = 1; |
1807
|
|
|
|
|
|
|
} else { |
1808
|
12
|
50
|
|
|
|
26
|
$ctx->{log}->($ctx, 'eliminate', $code, "remaining local var $s") if $ctx->{log}; |
1809
|
12
|
|
|
|
|
22
|
$info->{remaining_locals}{$s} = 1; |
1810
|
|
|
|
|
|
|
} |
1811
|
|
|
|
|
|
|
} else { |
1812
|
4
|
50
|
|
|
|
13
|
$ctx->{log}->($ctx, 'eliminate', $code, "remaining unknown var $s") if $ctx->{log}; |
1813
|
4
|
|
|
|
|
11
|
$info->{remaining_locals}{$s} = 1; |
1814
|
|
|
|
|
|
|
} |
1815
|
|
|
|
|
|
|
} |
1816
|
765
|
|
|
|
|
1507
|
return; |
1817
|
207
|
|
|
|
|
4765
|
}); |
1818
|
|
|
|
|
|
|
|
1819
|
207
|
100
|
|
|
|
6925
|
if ($out ne $code) { |
1820
|
72
|
50
|
|
|
|
222
|
$ctx->{log}->($ctx, 'eliminate', $code, "changed -> $out") if $ctx->{log}; |
1821
|
|
|
|
|
|
|
} |
1822
|
207
|
|
|
|
|
514
|
return $out; |
1823
|
|
|
|
|
|
|
} |
1824
|
|
|
|
|
|
|
|
1825
|
|
|
|
|
|
|
# convert assignment followed directly by return to single return |
1826
|
|
|
|
|
|
|
# |
1827
|
|
|
|
|
|
|
sub convert_assign_return { |
1828
|
512
|
|
|
512
|
0
|
880
|
my ($ctx, $code) = @_; |
1829
|
512
|
|
|
|
|
825
|
my $parser = $ctx->{parser}; |
1830
|
|
|
|
|
|
|
|
1831
|
|
|
|
|
|
|
my $out = $parser->map_stmt($code, sub { |
1832
|
1818
|
|
|
1818
|
|
2877
|
my ($s) = @_; |
1833
|
|
|
|
|
|
|
|
1834
|
1818
|
100
|
|
|
|
3875
|
if ($s =~ /^#blk\d+$/) { |
1835
|
212
|
|
|
|
|
327
|
my ($type, $a) = @{$parser->{strmap}->{$s}}; |
|
212
|
|
|
|
|
546
|
|
1836
|
212
|
|
|
|
|
358
|
my @args = (); |
1837
|
212
|
|
|
|
|
309
|
my $arg_changed = 0; |
1838
|
|
|
|
|
|
|
|
1839
|
212
|
|
|
|
|
544
|
for (my $i=0; $i < scalar @$a; $i++) { |
1840
|
311
|
|
|
|
|
565
|
my $k = $a->[$i]; |
1841
|
311
|
100
|
|
|
|
643
|
if (($i+1) < scalar @$a) { |
1842
|
102
|
|
|
|
|
236
|
my $k2 = $a->[$i+1]; |
1843
|
102
|
|
|
|
|
150
|
my $var; |
1844
|
102
|
100
|
|
|
|
311
|
if ($k2 =~ /^#stmt\d+$/) { |
1845
|
82
|
|
|
|
|
159
|
my $cmd2 = $parser->{strmap}->{$k2}->[0]; |
1846
|
82
|
100
|
|
|
|
209
|
if ($cmd2 eq 'return') { |
1847
|
74
|
|
|
|
|
155
|
$var = $parser->{strmap}->{$k2}->[1]; |
1848
|
|
|
|
|
|
|
} |
1849
|
|
|
|
|
|
|
} |
1850
|
102
|
100
|
100
|
|
|
404
|
if (defined $var && ($k =~ /^#expr\d+$/)) { |
1851
|
67
|
|
|
|
|
105
|
my ($op, $v1, $v2) = @{$parser->{strmap}->{$k}}; |
|
67
|
|
|
|
|
207
|
|
1852
|
67
|
100
|
66
|
|
|
326
|
if (($op eq '=') && ($var eq $v1)) { |
1853
|
2
|
|
|
|
|
10
|
my $r = $parser->setstmt(['return', $v2]); |
1854
|
2
|
50
|
|
|
|
15
|
$ctx->{log}->($ctx, 'convert', $code, "assign_return $k+$k2 -> $r") if $ctx->{log}; |
1855
|
2
|
|
|
|
|
5
|
push(@args, $r); |
1856
|
2
|
|
|
|
|
5
|
$arg_changed = 1; |
1857
|
2
|
|
|
|
|
5
|
$i++; |
1858
|
2
|
|
|
|
|
6
|
next; |
1859
|
|
|
|
|
|
|
} |
1860
|
|
|
|
|
|
|
} |
1861
|
|
|
|
|
|
|
} |
1862
|
309
|
|
|
|
|
706
|
my $v = $ctx->convert_assign_return($k); |
1863
|
309
|
50
|
|
|
|
648
|
if ($v ne $k) { |
1864
|
0
|
0
|
|
|
|
0
|
unless ($parser->is_empty_block($v)) { |
1865
|
0
|
|
|
|
|
0
|
push(@args, $v); |
1866
|
|
|
|
|
|
|
} |
1867
|
0
|
|
|
|
|
0
|
$arg_changed = 1; |
1868
|
|
|
|
|
|
|
} else { |
1869
|
309
|
|
|
|
|
945
|
push(@args, $v); |
1870
|
|
|
|
|
|
|
} |
1871
|
|
|
|
|
|
|
} |
1872
|
212
|
100
|
|
|
|
484
|
if ($arg_changed) { |
1873
|
2
|
|
|
|
|
10
|
$s = $parser->setblk($type, \@args); |
1874
|
2
|
|
|
|
|
5
|
return $s; |
1875
|
|
|
|
|
|
|
} |
1876
|
|
|
|
|
|
|
} |
1877
|
1816
|
|
|
|
|
3295
|
return; |
1878
|
512
|
|
|
|
|
3913
|
}); |
1879
|
|
|
|
|
|
|
|
1880
|
512
|
100
|
|
|
|
5135
|
if ($out ne $code) { |
1881
|
2
|
50
|
|
|
|
11
|
$ctx->{log}->($ctx, 'convert', $code, "assign_return changed -> $out") if $ctx->{log}; |
1882
|
|
|
|
|
|
|
} |
1883
|
512
|
|
|
|
|
1030
|
return $out; |
1884
|
|
|
|
|
|
|
} |
1885
|
|
|
|
|
|
|
|
1886
|
|
|
|
|
|
|
# convert globals so that they match toplevel or another function |
1887
|
|
|
|
|
|
|
# |
1888
|
|
|
|
|
|
|
sub convert_globals_to_caller_ctx { |
1889
|
297
|
|
|
297
|
0
|
652
|
my ($ctx, $info, $code, $cctx) = @_; |
1890
|
297
|
|
|
|
|
496
|
my $parser = $ctx->{parser}; |
1891
|
|
|
|
|
|
|
|
1892
|
297
|
100
|
|
|
|
410
|
unless (scalar keys %{$info->{global_assigns}} > 0) { |
|
297
|
|
|
|
|
885
|
|
1893
|
286
|
|
|
|
|
652
|
return $code; # no global exists |
1894
|
|
|
|
|
|
|
} |
1895
|
|
|
|
|
|
|
|
1896
|
|
|
|
|
|
|
my $out = $parser->map_stmt($code, sub { |
1897
|
68
|
|
|
68
|
|
119
|
my ($s) = @_; |
1898
|
|
|
|
|
|
|
|
1899
|
68
|
100
|
|
|
|
188
|
if ($s =~ /^#stmt\d+$/) { |
|
|
100
|
|
|
|
|
|
1900
|
4
|
|
|
|
|
11
|
my $cmd = $parser->{strmap}->{$s}->[0]; |
1901
|
4
|
50
|
|
|
|
25
|
if ($cmd eq 'global') { |
1902
|
4
|
|
|
|
|
12
|
my $arglist = $parser->{strmap}->{$s}->[1]; |
1903
|
4
|
50
|
|
|
|
13
|
$ctx->{log}->($ctx, 'convert', $code, "global $s -> drop global stmt") if $ctx->{log}; |
1904
|
4
|
|
|
|
|
16
|
my $empty = $parser->setblk('flat', []); |
1905
|
4
|
|
|
|
|
14
|
return $empty; |
1906
|
|
|
|
|
|
|
} |
1907
|
|
|
|
|
|
|
} elsif (is_variable($s)) { |
1908
|
16
|
|
|
|
|
70
|
my $g = $ctx->is_global_var($s); |
1909
|
16
|
|
|
|
|
56
|
my ($inst, $instvar) = inst_split($s); |
1910
|
|
|
|
|
|
|
|
1911
|
16
|
50
|
66
|
|
|
88
|
if (defined $inst && ($inst ne 'GLOBALS')) { |
|
|
100
|
|
|
|
|
|
1912
|
0
|
0
|
|
|
|
0
|
if ($inst =~ /^#inst\d+$/) { |
1913
|
0
|
0
|
|
|
|
0
|
$ctx->{log}->($ctx, 'convert', $code, "global $s -> is instvar") if $ctx->{log}; |
1914
|
|
|
|
|
|
|
} else { |
1915
|
0
|
0
|
|
|
|
0
|
$ctx->{log}->($ctx, 'convert', $code, "global $s -> is classvar") if $ctx->{log}; |
1916
|
|
|
|
|
|
|
} |
1917
|
|
|
|
|
|
|
} elsif (defined $g) { |
1918
|
10
|
50
|
|
|
|
32
|
if ($cctx->{infunction}) { |
1919
|
0
|
|
|
|
|
0
|
my $v = global_var($g); # keep global annotation |
1920
|
0
|
|
|
|
|
0
|
return $v; |
1921
|
|
|
|
|
|
|
} else { |
1922
|
|
|
|
|
|
|
# caller is toplevel |
1923
|
10
|
|
|
|
|
29
|
return $g; |
1924
|
|
|
|
|
|
|
} |
1925
|
|
|
|
|
|
|
} |
1926
|
|
|
|
|
|
|
} |
1927
|
54
|
|
|
|
|
106
|
return; |
1928
|
11
|
|
|
|
|
100
|
}); |
1929
|
|
|
|
|
|
|
|
1930
|
11
|
100
|
|
|
|
134
|
if ($out ne $code) { |
1931
|
10
|
50
|
|
|
|
29
|
$ctx->{log}->($ctx, 'convert', $code, "global changed -> $out") if $ctx->{log}; |
1932
|
|
|
|
|
|
|
} |
1933
|
11
|
|
|
|
|
27
|
return $out; |
1934
|
|
|
|
|
|
|
} |
1935
|
|
|
|
|
|
|
|
1936
|
|
|
|
|
|
|
# convert global vars to explicit globals |
1937
|
|
|
|
|
|
|
# |
1938
|
|
|
|
|
|
|
sub globlify_local_vars { |
1939
|
4
|
|
|
4
|
0
|
9
|
my ($ctx, $info, $code) = @_; |
1940
|
4
|
|
|
|
|
10
|
my $parser = $ctx->{parser}; |
1941
|
|
|
|
|
|
|
|
1942
|
|
|
|
|
|
|
my $out = $parser->map_stmt($code, sub { |
1943
|
16
|
|
|
16
|
|
27
|
my ($s) = @_; |
1944
|
|
|
|
|
|
|
|
1945
|
16
|
100
|
|
|
|
36
|
if (is_variable($s)) { |
1946
|
5
|
|
|
|
|
20
|
my ($inst, $instvar) = inst_split($s); |
1947
|
|
|
|
|
|
|
|
1948
|
5
|
50
|
0
|
|
|
21
|
if ($ctx->is_superglobal($s)) { |
|
|
0
|
0
|
|
|
|
|
|
|
0
|
0
|
|
|
|
|
|
|
0
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
1949
|
5
|
50
|
|
|
|
27
|
$ctx->{log}->($ctx, 'globlify', $code, "keep superglobal $s") if $ctx->{log}; |
1950
|
|
|
|
|
|
|
} elsif (exists $ctx->{varmap}{ref}{$s}) { |
1951
|
0
|
0
|
|
|
|
0
|
$ctx->{log}->($ctx, 'globlify', $code, "keep ref var $s") if $ctx->{log}; |
1952
|
|
|
|
|
|
|
} elsif (exists $ctx->{varmap}{global}{$s}) { |
1953
|
0
|
0
|
|
|
|
0
|
$ctx->{log}->($ctx, 'globlify', $code, "keep global var $s") if $ctx->{log}; |
1954
|
|
|
|
|
|
|
} elsif (defined $inst && ($inst eq 'GLOBALS')) { |
1955
|
0
|
0
|
|
|
|
0
|
$ctx->{log}->($ctx, 'globlify', $code, "keep global var $s") if $ctx->{log}; |
1956
|
|
|
|
|
|
|
} elsif ($ctx->{infunction} && exists $ctx->{varmap}{static}{$ctx->{infunction}}{$s}) { |
1957
|
0
|
0
|
|
|
|
0
|
$ctx->{log}->($ctx, 'globlify', $code, "keep static func var $s") if $ctx->{log}; |
1958
|
|
|
|
|
|
|
} elsif (defined $inst && exists $ctx->{class_scope} && (lc($inst) eq $ctx->{class_scope})) { |
1959
|
0
|
0
|
|
|
|
0
|
$ctx->{log}->($ctx, 'globlify', $code, "keep static class var $s") if $ctx->{log}; |
1960
|
|
|
|
|
|
|
} elsif (exists $info->{vars}{$s}) { |
1961
|
0
|
0
|
|
|
|
0
|
$ctx->{log}->($ctx, 'globlify', $code, "remaining local var $s") if $ctx->{log}; |
1962
|
0
|
|
|
|
|
0
|
my $v = global_var($s); |
1963
|
0
|
|
|
|
|
0
|
return $v; |
1964
|
|
|
|
|
|
|
} |
1965
|
|
|
|
|
|
|
} |
1966
|
16
|
|
|
|
|
33
|
return; |
1967
|
4
|
|
|
|
|
45
|
}); |
1968
|
|
|
|
|
|
|
|
1969
|
4
|
50
|
|
|
|
69
|
if ($out ne $code) { |
1970
|
0
|
0
|
|
|
|
0
|
$ctx->{log}->($ctx, 'globlify', $code, "changed -> $out") if $ctx->{log}; |
1971
|
|
|
|
|
|
|
} |
1972
|
4
|
|
|
|
|
9
|
return $out; |
1973
|
|
|
|
|
|
|
} |
1974
|
|
|
|
|
|
|
|
1975
|
|
|
|
|
|
|
sub _remove_final_statement { |
1976
|
127
|
|
|
127
|
|
294
|
my ($parser, $pattern, $code) = @_; |
1977
|
127
|
|
|
|
|
206
|
my @seq = (); |
1978
|
127
|
|
|
|
|
192
|
my @out = (); |
1979
|
127
|
|
|
|
|
196
|
my $changed = 0; |
1980
|
|
|
|
|
|
|
|
1981
|
127
|
|
|
|
|
398
|
$parser->flatten_block($code, \@seq); |
1982
|
|
|
|
|
|
|
|
1983
|
127
|
|
|
|
|
297
|
foreach my $s (@seq) { |
1984
|
142
|
100
|
|
|
|
470
|
if ($s =~ /^#stmt\d+$/) { |
1985
|
129
|
|
|
|
|
259
|
my $cmd = $parser->{strmap}->{$s}->[0]; |
1986
|
129
|
100
|
|
|
|
802
|
if ($cmd =~ /^$pattern$/) { |
1987
|
127
|
|
|
|
|
267
|
$changed = 1; |
1988
|
127
|
|
|
|
|
314
|
next; |
1989
|
|
|
|
|
|
|
} |
1990
|
|
|
|
|
|
|
} |
1991
|
15
|
|
|
|
|
34
|
push(@out, $s); |
1992
|
|
|
|
|
|
|
} |
1993
|
127
|
50
|
|
|
|
298
|
if ($changed) { |
1994
|
127
|
|
|
|
|
362
|
return _flat_block_or_single($parser, \@out); |
1995
|
|
|
|
|
|
|
} |
1996
|
0
|
|
|
|
|
0
|
return $code; |
1997
|
|
|
|
|
|
|
} |
1998
|
|
|
|
|
|
|
|
1999
|
|
|
|
|
|
|
# can_inline is called for the callee context, and the final return |
2000
|
|
|
|
|
|
|
# statement is already removed (if function returns a value). |
2001
|
|
|
|
|
|
|
# |
2002
|
|
|
|
|
|
|
sub can_inline { |
2003
|
249
|
|
|
249
|
0
|
477
|
my ($ctx, $code) = @_; |
2004
|
249
|
|
|
|
|
388
|
my $parser = $ctx->{parser}; |
2005
|
249
|
|
|
|
|
361
|
my $allow = 1; |
2006
|
|
|
|
|
|
|
|
2007
|
|
|
|
|
|
|
my $out = $parser->map_stmt($code, sub { |
2008
|
317
|
|
|
317
|
|
520
|
my ($s) = @_; |
2009
|
317
|
100
|
|
|
|
676
|
return $s unless $allow; |
2010
|
|
|
|
|
|
|
|
2011
|
313
|
100
|
|
|
|
1651
|
if ($s =~ /^#stmt\d+$/) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
2012
|
38
|
|
|
|
|
106
|
my $cmd = $parser->{strmap}->{$s}->[0]; |
2013
|
38
|
100
|
|
|
|
110
|
if ($cmd eq 'echo') { |
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
2014
|
33
|
|
|
|
|
62
|
my $arglist = $parser->{strmap}->{$s}->[1]; |
2015
|
33
|
|
|
|
|
57
|
foreach my $a (@$arglist) { |
2016
|
33
|
50
|
|
|
|
83
|
unless ($ctx->can_inline($a)) { |
2017
|
0
|
|
|
|
|
0
|
$allow = 0; |
2018
|
0
|
|
|
|
|
0
|
last; |
2019
|
|
|
|
|
|
|
} |
2020
|
|
|
|
|
|
|
} |
2021
|
33
|
|
|
|
|
84
|
return $s; |
2022
|
|
|
|
|
|
|
} elsif ($cmd eq 'print') { |
2023
|
0
|
|
|
|
|
0
|
my $arg = $parser->{strmap}->{$s}->[1]; |
2024
|
0
|
0
|
|
|
|
0
|
if ($ctx->can_inline($arg)) { |
2025
|
0
|
|
|
|
|
0
|
$allow = 0; |
2026
|
|
|
|
|
|
|
} |
2027
|
0
|
|
|
|
|
0
|
return $s; |
2028
|
|
|
|
|
|
|
} elsif ($cmd eq 'global') { |
2029
|
4
|
|
|
|
|
14
|
return $s; |
2030
|
|
|
|
|
|
|
} elsif ($cmd eq 'return') { |
2031
|
0
|
0
|
|
|
|
0
|
$ctx->{log}->($ctx, 'inline', $code, "detected remaining return $s") if $ctx->{log}; |
2032
|
|
|
|
|
|
|
} else { |
2033
|
1
|
|
|
|
|
4
|
return; # check other statements |
2034
|
|
|
|
|
|
|
} |
2035
|
|
|
|
|
|
|
} elsif ($s =~ /^#blk\d+$/) { |
2036
|
165
|
|
|
|
|
406
|
return; # check block elements |
2037
|
|
|
|
|
|
|
} elsif ($s =~ /^#expr\d+$/) { |
2038
|
14
|
|
|
|
|
24
|
my ($op, $v1, $v2) = @{$parser->{strmap}->{$s}}; |
|
14
|
|
|
|
|
40
|
|
2039
|
|
|
|
|
|
|
|
2040
|
14
|
50
|
|
|
|
37
|
if ($op ne '$') { # keep varvar |
2041
|
14
|
50
|
|
|
|
33
|
if (defined $v1) { |
2042
|
14
|
100
|
|
|
|
45
|
unless ($ctx->can_inline($v1)) { |
2043
|
1
|
|
|
|
|
4
|
$allow = 0; |
2044
|
|
|
|
|
|
|
} |
2045
|
|
|
|
|
|
|
} |
2046
|
14
|
100
|
66
|
|
|
63
|
if ($allow && defined $v2) { |
2047
|
13
|
50
|
|
|
|
33
|
unless ($ctx->can_inline($v2)) { |
2048
|
0
|
|
|
|
|
0
|
$allow = 0; |
2049
|
|
|
|
|
|
|
} |
2050
|
|
|
|
|
|
|
} |
2051
|
14
|
|
|
|
|
37
|
return $s; |
2052
|
|
|
|
|
|
|
} |
2053
|
|
|
|
|
|
|
} elsif ($s =~ /^#elem\d+$/) { |
2054
|
6
|
|
|
|
|
16
|
my ($v, $i) = @{$parser->{strmap}->{$s}}; |
|
6
|
|
|
|
|
18
|
|
2055
|
|
|
|
|
|
|
|
2056
|
6
|
50
|
|
|
|
19
|
unless ($ctx->can_inline($v)) { |
2057
|
0
|
|
|
|
|
0
|
$allow = 0; |
2058
|
|
|
|
|
|
|
} |
2059
|
6
|
50
|
33
|
|
|
25
|
if ($allow && defined $i) { |
2060
|
6
|
50
|
|
|
|
16
|
unless ($ctx->can_inline($i)) { |
2061
|
0
|
|
|
|
|
0
|
$allow = 0; |
2062
|
|
|
|
|
|
|
} |
2063
|
|
|
|
|
|
|
} |
2064
|
6
|
|
|
|
|
17
|
return $s; |
2065
|
|
|
|
|
|
|
} elsif ($s =~ /^#call\d+$/) { |
2066
|
13
|
|
|
|
|
21
|
my ($name, $arglist) = @{$parser->{strmap}->{$s}}; |
|
13
|
|
|
|
|
49
|
|
2067
|
13
|
|
|
|
|
43
|
my ($inst, $prop) = method_split($name); |
2068
|
13
|
0
|
66
|
|
|
66
|
if (defined $inst || is_symbol($name) || is_strval($name) || ($name =~ /^#fun\d+$/)) { |
|
|
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
2069
|
13
|
50
|
|
|
|
68
|
unless ($name =~ /^(eval|create_function)$/i) { |
2070
|
13
|
|
|
|
|
23
|
my $can = 1; |
2071
|
13
|
|
|
|
|
25
|
my $arglist = $parser->{strmap}->{$s}->[1]; |
2072
|
13
|
|
|
|
|
25
|
foreach my $a (@$arglist) { |
2073
|
4
|
50
|
|
|
|
11
|
unless ($ctx->can_inline($a)) { |
2074
|
0
|
|
|
|
|
0
|
$can = 0; |
2075
|
0
|
|
|
|
|
0
|
last; |
2076
|
|
|
|
|
|
|
} |
2077
|
|
|
|
|
|
|
} |
2078
|
13
|
50
|
|
|
|
41
|
if ($can) { |
2079
|
13
|
50
|
|
|
|
54
|
$ctx->{log}->($ctx, 'inline', $code, "$s [$name] is allowed func") if $ctx->{log}; |
2080
|
13
|
|
|
|
|
47
|
return $s; |
2081
|
|
|
|
|
|
|
} |
2082
|
|
|
|
|
|
|
} |
2083
|
|
|
|
|
|
|
} |
2084
|
|
|
|
|
|
|
} elsif ($s =~ /^#fun\d+$/) { |
2085
|
5
|
|
|
|
|
12
|
return $s; |
2086
|
|
|
|
|
|
|
} elsif ($s =~ /^#class\d+$/) { |
2087
|
0
|
|
|
|
|
0
|
return $s; |
2088
|
|
|
|
|
|
|
} elsif (is_strval($s)) { |
2089
|
53
|
50
|
|
|
|
173
|
$ctx->{log}->($ctx, 'inline', $code, "$s is strval") if $ctx->{log}; |
2090
|
53
|
|
|
|
|
153
|
return $s; |
2091
|
|
|
|
|
|
|
} elsif (is_array($s)) { |
2092
|
0
|
0
|
|
|
|
0
|
if (PHP::Decode::Op::array_is_const($parser, $s)) { |
2093
|
0
|
0
|
|
|
|
0
|
$ctx->{log}->($ctx, 'inline', $code, "$s is const array") if $ctx->{log}; |
2094
|
0
|
|
|
|
|
0
|
return $s; |
2095
|
|
|
|
|
|
|
} |
2096
|
|
|
|
|
|
|
} elsif (is_variable($s)) { |
2097
|
19
|
|
|
|
|
52
|
my ($inst, $instvar) = inst_split($s); |
2098
|
|
|
|
|
|
|
|
2099
|
19
|
100
|
66
|
|
|
60
|
if ($ctx->is_superglobal($s)) { |
|
|
50
|
66
|
|
|
|
|
|
|
100
|
|
|
|
|
|
2100
|
7
|
50
|
|
|
|
23
|
$ctx->{log}->($ctx, 'inline', $code, "$s is superglobal") if $ctx->{log}; |
2101
|
7
|
|
|
|
|
30
|
return $s; |
2102
|
|
|
|
|
|
|
} elsif (defined $inst && ($inst ne 'GLOBALS')) { |
2103
|
0
|
0
|
|
|
|
0
|
$ctx->{log}->($ctx, 'inline', $code, "$s is global") if $ctx->{log}; |
2104
|
0
|
|
|
|
|
0
|
return $s; |
2105
|
|
|
|
|
|
|
} elsif (defined $inst && !($inst =~ /^#inst\d+$/)) { |
2106
|
10
|
50
|
|
|
|
29
|
$ctx->{log}->($ctx, 'inline', $code, "$s is classvar") if $ctx->{log}; |
2107
|
10
|
|
|
|
|
31
|
return $s; |
2108
|
|
|
|
|
|
|
} |
2109
|
|
|
|
|
|
|
} |
2110
|
2
|
|
|
|
|
14
|
$ctx->{warn}->($ctx, 'inline', $code, "disallow stmt $s"); |
2111
|
2
|
|
|
|
|
90
|
$allow = 0; |
2112
|
2
|
|
|
|
|
7
|
return; |
2113
|
249
|
|
|
|
|
1723
|
}); |
2114
|
249
|
|
|
|
|
4156
|
return $allow; |
2115
|
|
|
|
|
|
|
} |
2116
|
|
|
|
|
|
|
|
2117
|
|
|
|
|
|
|
# can_inline_eval is called for the caller context, and the final return |
2118
|
|
|
|
|
|
|
# statement is already removed (if function returns a value). |
2119
|
|
|
|
|
|
|
# |
2120
|
|
|
|
|
|
|
sub can_inline_eval { |
2121
|
45
|
|
|
45
|
0
|
109
|
my ($ctx, $code) = @_; |
2122
|
45
|
|
|
|
|
77
|
my $parser = $ctx->{parser}; |
2123
|
45
|
|
|
|
|
70
|
my $allow = 1; |
2124
|
|
|
|
|
|
|
|
2125
|
|
|
|
|
|
|
my $out = $parser->map_stmt($code, sub { |
2126
|
52
|
|
|
52
|
|
101
|
my ($s) = @_; |
2127
|
52
|
50
|
|
|
|
135
|
return $s unless $allow; |
2128
|
|
|
|
|
|
|
|
2129
|
52
|
100
|
|
|
|
340
|
if ($s =~ /^#stmt\d+$/) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
2130
|
11
|
|
|
|
|
28
|
my $cmd = $parser->{strmap}->{$s}->[0]; |
2131
|
11
|
100
|
|
|
|
51
|
if ($cmd eq 'echo') { |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
2132
|
9
|
|
|
|
|
29
|
return $s; |
2133
|
|
|
|
|
|
|
} elsif ($cmd eq 'print') { |
2134
|
0
|
|
|
|
|
0
|
return $s; |
2135
|
|
|
|
|
|
|
} elsif ($cmd eq 'return') { |
2136
|
0
|
0
|
|
|
|
0
|
$ctx->{log}->($ctx, 'inline', $code, "detected remaining return $s") if $ctx->{log}; |
2137
|
|
|
|
|
|
|
} elsif ($cmd =~ /^(if|while|do|for|foreach|switch)$/) { |
2138
|
|
|
|
|
|
|
#return; # check other statements |
2139
|
2
|
|
|
|
|
6
|
return $s; |
2140
|
|
|
|
|
|
|
} |
2141
|
|
|
|
|
|
|
} elsif ($s =~ /^#blk\d+$/) { |
2142
|
11
|
|
|
|
|
26
|
return; # check block elements |
2143
|
|
|
|
|
|
|
} elsif ($s =~ /^#expr\d+$/) { |
2144
|
|
|
|
|
|
|
# $var = |
2145
|
5
|
|
|
|
|
33
|
my ($op, $v1, $v2) = @{$parser->{strmap}->{$s}}; |
|
5
|
|
|
|
|
22
|
|
2146
|
5
|
50
|
|
|
|
16
|
if ($op eq '=') { |
2147
|
5
|
50
|
|
|
|
16
|
if (is_strval($v2)) { |
2148
|
5
|
|
|
|
|
10
|
return $s; |
2149
|
|
|
|
|
|
|
} |
2150
|
|
|
|
|
|
|
} |
2151
|
|
|
|
|
|
|
} elsif ($s =~ /^#call\d+$/) { |
2152
|
|
|
|
|
|
|
# call without eval can not generate 'return ' |
2153
|
0
|
|
|
|
|
0
|
my ($_name, $_arglist) = @{$parser->{strmap}->{$s}}; |
|
0
|
|
|
|
|
0
|
|
2154
|
0
|
0
|
|
|
|
0
|
if (!PHP::Decode::Func::func_may_return_string($_name)) { |
2155
|
0
|
|
|
|
|
0
|
return $s; |
2156
|
|
|
|
|
|
|
} |
2157
|
|
|
|
|
|
|
} elsif ($s =~ /^#fun\d+$/) { |
2158
|
6
|
|
|
|
|
20
|
return $s; |
2159
|
|
|
|
|
|
|
} elsif ($s =~ /^#class\d+$/) { |
2160
|
0
|
|
|
|
|
0
|
return $s; |
2161
|
|
|
|
|
|
|
} elsif (is_strval($s)) { |
2162
|
19
|
|
|
|
|
49
|
return $s; |
2163
|
|
|
|
|
|
|
} |
2164
|
0
|
|
|
|
|
0
|
$ctx->{warn}->($ctx, 'inline', $code, "eval disallow stmt $s"); |
2165
|
0
|
|
|
|
|
0
|
$allow = 0; |
2166
|
0
|
|
|
|
|
0
|
return; |
2167
|
45
|
|
|
|
|
334
|
}); |
2168
|
45
|
|
|
|
|
521
|
return $allow; |
2169
|
|
|
|
|
|
|
} |
2170
|
|
|
|
|
|
|
|
2171
|
|
|
|
|
|
|
# check if function body might return |
2172
|
|
|
|
|
|
|
# |
2173
|
|
|
|
|
|
|
sub _can_return { |
2174
|
203
|
|
|
203
|
|
401
|
my ($info) = @_; |
2175
|
|
|
|
|
|
|
|
2176
|
203
|
50
|
66
|
|
|
804
|
if (exists $info->{returns} || exists $info->{calls}{'eval'} || exists $info->{calls}{'create_function'}) { |
|
|
|
33
|
|
|
|
|
2177
|
130
|
|
|
|
|
380
|
return 1; |
2178
|
|
|
|
|
|
|
} |
2179
|
73
|
|
|
|
|
205
|
return 0; |
2180
|
|
|
|
|
|
|
} |
2181
|
|
|
|
|
|
|
|
2182
|
|
|
|
|
|
|
sub _find_unresolved_param { |
2183
|
182
|
|
|
182
|
|
392
|
my ($info, $param) = @_; |
2184
|
182
|
|
|
|
|
316
|
my $param_found = 0; |
2185
|
|
|
|
|
|
|
|
2186
|
182
|
|
|
|
|
504
|
for (my $i=0; $i < scalar @$param; $i++) { |
2187
|
122
|
100
|
|
|
|
362
|
if ($param->[$i] =~ /^#ref\d+$/) { |
2188
|
3
|
|
|
|
|
16
|
$param_found = $param->[$i]; |
2189
|
|
|
|
|
|
|
} |
2190
|
122
|
50
|
|
|
|
399
|
if (exists $info->{vars}{$param->[$i]}) { |
2191
|
0
|
|
|
|
|
0
|
$param_found = $param->[$i]; |
2192
|
|
|
|
|
|
|
} |
2193
|
|
|
|
|
|
|
} |
2194
|
182
|
|
|
|
|
383
|
return $param_found; |
2195
|
|
|
|
|
|
|
} |
2196
|
|
|
|
|
|
|
|
2197
|
|
|
|
|
|
|
sub set_func_params { |
2198
|
205
|
|
|
205
|
0
|
471
|
my ($ctx, $cmd, $arglist, $param) = @_; |
2199
|
205
|
|
|
|
|
310
|
my $parser = $ctx->{parser}; |
2200
|
|
|
|
|
|
|
|
2201
|
|
|
|
|
|
|
# optional params ($var = value) are given as #expr |
2202
|
|
|
|
|
|
|
# |
2203
|
|
|
|
|
|
|
# TODO: arrays are passed as value - to pass them per |
2204
|
|
|
|
|
|
|
# reference &$arr params are used. |
2205
|
|
|
|
|
|
|
# |
2206
|
205
|
|
|
|
|
305
|
my %varmap; |
2207
|
205
|
|
|
|
|
541
|
for (my $i=0; $i < scalar @$param; $i++) { |
2208
|
129
|
|
|
|
|
212
|
my $var; |
2209
|
|
|
|
|
|
|
my $val; |
2210
|
|
|
|
|
|
|
|
2211
|
129
|
100
|
|
|
|
257
|
if ($i < scalar @$arglist) { |
2212
|
127
|
|
|
|
|
242
|
$val = $arglist->[$i]; |
2213
|
|
|
|
|
|
|
} |
2214
|
129
|
100
|
|
|
|
333
|
if ($param->[$i] =~ /^#expr\d+$/) { |
|
|
100
|
|
|
|
|
|
2215
|
1
|
|
|
|
|
3
|
my ($op, $v1, $v2) = @{$parser->{strmap}->{$param->[$i]}}; |
|
1
|
|
|
|
|
6
|
|
2216
|
1
|
50
|
|
|
|
5
|
if ($op ne '=') { |
2217
|
0
|
|
|
|
|
0
|
$ctx->{warn}->($ctx, 'func', $cmd, "bad default param (skip): $param->[$i]"); |
2218
|
0
|
|
|
|
|
0
|
return; |
2219
|
|
|
|
|
|
|
} |
2220
|
1
|
|
|
|
|
2
|
$var = $v1; |
2221
|
|
|
|
|
|
|
|
2222
|
1
|
50
|
|
|
|
4
|
if (!defined $val) { |
2223
|
1
|
|
|
|
|
5
|
$val = $v2; # set default for optional param |
2224
|
|
|
|
|
|
|
} |
2225
|
|
|
|
|
|
|
} elsif ($param->[$i] =~ /^#ref\d+$/) { |
2226
|
3
|
|
|
|
|
11
|
$var = $parser->{strmap}->{$param->[$i]}->[0]; |
2227
|
3
|
50
|
|
|
|
11
|
unless (is_variable($val)) { |
2228
|
0
|
|
|
|
|
0
|
$ctx->{warn}->($ctx, 'func', $cmd, "no ref var (skip): $param->[$i] = $val"); |
2229
|
0
|
|
|
|
|
0
|
return; |
2230
|
|
|
|
|
|
|
} else { |
2231
|
3
|
|
|
|
|
23
|
$varmap{ref}{$var} = [$ctx, $val]; |
2232
|
3
|
50
|
|
|
|
12
|
$ctx->{log}->($ctx, 'func', $cmd, "$var references $val now") if $ctx->{log}; |
2233
|
|
|
|
|
|
|
|
2234
|
3
|
|
|
|
|
9
|
$val = $ctx->exec_statement($val, 1); # don't remove assignments like ($x = #unresolved) |
2235
|
|
|
|
|
|
|
} |
2236
|
|
|
|
|
|
|
} else { |
2237
|
125
|
100
|
|
|
|
263
|
if (!defined $val) { |
2238
|
1
|
|
|
|
|
8
|
$ctx->{warn}->($ctx, 'func', $cmd, "no default param (skip): $param->[$i] (too few params %d want %d)", scalar @$arglist, scalar @$param); |
2239
|
1
|
|
|
|
|
51
|
return; |
2240
|
|
|
|
|
|
|
} |
2241
|
124
|
|
|
|
|
200
|
$var = $param->[$i]; |
2242
|
|
|
|
|
|
|
} |
2243
|
128
|
50
|
|
|
|
311
|
if (is_variable($var)) { |
2244
|
128
|
|
|
|
|
504
|
my $info = {vars => {}, calls => {}, stmts => {}}; |
2245
|
128
|
|
|
|
|
457
|
$parser->stmt_info($val, $info); |
2246
|
|
|
|
|
|
|
|
2247
|
128
|
50
|
|
|
|
361
|
if (_skipped_call($parser, $val, '(.*)', $info)) { |
2248
|
0
|
|
|
|
|
0
|
$ctx->{warn}->($ctx, 'func', $cmd, "unresolved param (skip): $param->[$i] = $val"); |
2249
|
0
|
|
|
|
|
0
|
return; |
2250
|
|
|
|
|
|
|
} |
2251
|
128
|
50
|
66
|
|
|
366
|
if ($ctx->contains_local_var($info)) { |
|
|
50
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
2252
|
0
|
|
|
|
|
0
|
$ctx->{warn}->($ctx, 'func', $cmd, "unresolved local var param (skip): $param->[$i] = $val"); |
2253
|
0
|
|
|
|
|
0
|
return; |
2254
|
2
|
|
|
|
|
35
|
} elsif (($val =~ /^#expr\d+$/) && (scalar keys %{$info->{assigns}} > 0)) { |
2255
|
0
|
|
|
|
|
0
|
$ctx->{warn}->($ctx, 'func', $cmd, "unresolved expr param (skip): $param->[$i] = $val"); |
2256
|
0
|
|
|
|
|
0
|
return; |
2257
|
|
|
|
|
|
|
} elsif (($val =~ /^#expr\d+$/) && ($parser->{strmap}->{$val}->[0] eq '$')) { |
2258
|
1
|
|
|
|
|
10
|
$ctx->{warn}->($ctx, 'func', $cmd, "unresolved varvar param (skip): $param->[$i] = $val"); |
2259
|
1
|
|
|
|
|
46
|
return; |
2260
|
127
|
|
|
|
|
339
|
} elsif (scalar keys %{$info->{vars}} > 0) { |
2261
|
4
|
|
|
|
|
28
|
$val = $ctx->globlify_local_vars($info, $val); |
2262
|
4
|
|
|
|
|
12
|
$varmap{$var} = $val; |
2263
|
4
|
50
|
|
|
|
26
|
$ctx->{log}->($ctx, 'func', $cmd, "globlified param: $var = $val") if $ctx->{log}; |
2264
|
|
|
|
|
|
|
} else { |
2265
|
123
|
|
|
|
|
297
|
$varmap{$var} = $val; |
2266
|
123
|
50
|
|
|
|
618
|
$ctx->{log}->($ctx, 'func', $cmd, "param: $var = $val") if $ctx->{log}; |
2267
|
|
|
|
|
|
|
} |
2268
|
|
|
|
|
|
|
} |
2269
|
|
|
|
|
|
|
} |
2270
|
203
|
|
|
|
|
471
|
return \%varmap; |
2271
|
|
|
|
|
|
|
} |
2272
|
|
|
|
|
|
|
|
2273
|
|
|
|
|
|
|
# exec_func() returns: ($retval, $code) |
2274
|
|
|
|
|
|
|
# |
2275
|
|
|
|
|
|
|
# If the function returns with 'return', the result is returned only if |
2276
|
|
|
|
|
|
|
# no function call or variable access was skipped. |
2277
|
|
|
|
|
|
|
# |
2278
|
|
|
|
|
|
|
# Return the executed code as the second result param. |
2279
|
|
|
|
|
|
|
# If a function parameters can't be resolved resolved, keep original call. |
2280
|
|
|
|
|
|
|
# |
2281
|
|
|
|
|
|
|
# - call complete: |
2282
|
|
|
|
|
|
|
# ($ret, $code): $ret from func-return statement. |
2283
|
|
|
|
|
|
|
# (#noreturn, $code): return from void-func (substituted later by #null) |
2284
|
|
|
|
|
|
|
# |
2285
|
|
|
|
|
|
|
# For '$code=undef' keep original call-statement. |
2286
|
|
|
|
|
|
|
# Otherwise $code can be inlined by the caller. |
2287
|
|
|
|
|
|
|
# - when the function returns a value, it is not part of the code. |
2288
|
|
|
|
|
|
|
# - when local variables are left, $code is converted to an anonymous function call. |
2289
|
|
|
|
|
|
|
# - when call returns tainted state, set also caller tainted |
2290
|
|
|
|
|
|
|
# |
2291
|
|
|
|
|
|
|
# - call not completly executed: |
2292
|
|
|
|
|
|
|
# (#notaint, $code): return anonymous function for inlining |
2293
|
|
|
|
|
|
|
# (#notaint, undef): keep original call-statement |
2294
|
|
|
|
|
|
|
# undef: keep original call-statement & set tainted |
2295
|
|
|
|
|
|
|
# |
2296
|
|
|
|
|
|
|
# - constructor call: |
2297
|
|
|
|
|
|
|
# (#construct, $code): for constructor call just show executed statements |
2298
|
|
|
|
|
|
|
# |
2299
|
|
|
|
|
|
|
sub _exec_func { |
2300
|
205
|
|
|
205
|
|
485
|
my ($ctx, $cmd, $arglist, $param, $block) = @_; |
2301
|
205
|
|
|
|
|
329
|
my $parser = $ctx->{parser}; |
2302
|
|
|
|
|
|
|
|
2303
|
|
|
|
|
|
|
# all variables in functions have local scope except |
2304
|
|
|
|
|
|
|
# $GLOBALS[var] or varibales declared 'global $var'. |
2305
|
|
|
|
|
|
|
# |
2306
|
205
|
|
|
|
|
533
|
my $varmap = $ctx->set_func_params($cmd, $arglist, $param); |
2307
|
205
|
100
|
|
|
|
475
|
if (!defined $varmap) { |
2308
|
2
|
|
|
|
|
7
|
return; |
2309
|
|
|
|
|
|
|
} |
2310
|
203
|
50
|
|
|
|
431
|
$ctx->{log}->($ctx, 'func', $cmd, "START with varmap: [%s]", join(' ', keys %$varmap)) if $ctx->{log}; |
2311
|
|
|
|
|
|
|
#$ctx->{log}->($ctx, 'func', $cmd, "%s", $parser->format_stmt($block)) if $ctx->{log}; |
2312
|
|
|
|
|
|
|
#$ctx->{log}->($ctx, 'func', $cmd, "GLOBALS %s BLOCK %s", join(' ', keys %{$ctx->{globals}}), $block) if $ctx->{log}; |
2313
|
|
|
|
|
|
|
|
2314
|
203
|
|
|
|
|
292
|
my $out; |
2315
|
203
|
|
|
|
|
612
|
my $ctx2 = $ctx->subscope_ctx(varmap => $varmap, infunction => lc($cmd), incall => 1); |
2316
|
203
|
|
|
|
|
532
|
$ctx2->{varhist} = {}; |
2317
|
|
|
|
|
|
|
|
2318
|
203
|
|
|
|
|
328
|
my $is_construct; |
2319
|
203
|
|
|
|
|
750
|
my ($inst, $prop) = method_split(lc($cmd)); |
2320
|
203
|
100
|
|
|
|
531
|
if (defined $inst) { |
2321
|
54
|
|
|
|
|
190
|
my $method = $ctx->lookup_method_name(lc($cmd)); # lookup instance function |
2322
|
54
|
100
|
|
|
|
192
|
if (defined $method) { |
2323
|
24
|
|
|
|
|
49
|
$cmd = $method; |
2324
|
24
|
|
|
|
|
57
|
$ctx2->{varmap}{'$this'} = $inst; # init $this var for instance |
2325
|
24
|
100
|
|
|
|
86
|
if ($prop eq '__construct') { |
|
|
100
|
|
|
|
|
|
2326
|
4
|
|
|
|
|
22
|
$is_construct = 1; |
2327
|
|
|
|
|
|
|
} elsif (lc($cmd) eq method_name($prop, $prop)) { |
2328
|
2
|
|
|
|
|
7
|
$is_construct = 1; |
2329
|
|
|
|
|
|
|
} |
2330
|
|
|
|
|
|
|
} else { |
2331
|
30
|
|
|
|
|
64
|
$ctx2->{class_scope} = $inst; # is class call |
2332
|
|
|
|
|
|
|
} |
2333
|
|
|
|
|
|
|
} |
2334
|
203
|
100
|
|
|
|
606
|
$ctx2->{infunction} = ($cmd =~ /^#fun\d+$/) ? '{closure}' : lc($cmd); |
2335
|
|
|
|
|
|
|
|
2336
|
203
|
|
|
|
|
527
|
my $res = $ctx2->exec_statement($block); |
2337
|
203
|
50
|
|
|
|
499
|
if (defined $res) { |
2338
|
203
|
|
|
|
|
548
|
$res = $ctx2->convert_assign_return($res); |
2339
|
203
|
50
|
|
|
|
588
|
$ctx->{log}->($ctx, 'func', $cmd, "res: $res '%s'", $parser->format_stmt($res)) if $ctx->{log}; |
2340
|
203
|
100
|
|
|
|
530
|
if (is_block($res)) { |
2341
|
200
|
|
|
|
|
321
|
my ($type, $a) = @{$parser->{strmap}->{$res}}; |
|
200
|
|
|
|
|
490
|
|
2342
|
200
|
|
|
|
|
414
|
$out = $a; |
2343
|
|
|
|
|
|
|
} else { |
2344
|
3
|
|
|
|
|
11
|
$out = [$res]; |
2345
|
|
|
|
|
|
|
} |
2346
|
|
|
|
|
|
|
} |
2347
|
203
|
50
|
|
|
|
477
|
if (defined $out) { |
2348
|
203
|
|
|
|
|
348
|
my $unresolved_param; |
2349
|
203
|
|
|
|
|
334
|
my $keep_call = 0; |
2350
|
203
|
|
|
|
|
624
|
my $resinfo = $ctx->get_unresolved_info($cmd, $res); |
2351
|
|
|
|
|
|
|
|
2352
|
203
|
100
|
|
|
|
544
|
if (scalar @$out > 0) { |
2353
|
202
|
|
|
|
|
450
|
my $r = _final_break($parser, $res, '(return)'); |
2354
|
202
|
|
|
|
|
567
|
my $f = _skipped_call($parser, $res, '(.*)', $resinfo); |
2355
|
202
|
|
|
|
|
555
|
my $u = $ctx2->unresolvable_var($resinfo); # allow to return superglobal result |
2356
|
|
|
|
|
|
|
|
2357
|
202
|
100
|
|
|
|
388
|
$ctx->{warn}->($ctx, 'func', $cmd, "found remaining [global assigns: %s, local assigns: %s, var: %s, calls: %s (%s)]: %s -> %s", join(' ', keys %{$resinfo->{global_assigns}}), join(' ', keys %{$resinfo->{local_assigns}}), $u ? $u : '-', $f ? $f : '-', join(' ', keys %{$resinfo->{calls}}), $block, $res); |
|
202
|
100
|
|
|
|
518
|
|
|
202
|
|
|
|
|
678
|
|
|
202
|
|
|
|
|
1017
|
|
2358
|
|
|
|
|
|
|
|
2359
|
202
|
|
|
|
|
11144
|
my $res1 = $ctx2->eliminate_local_assigments($resinfo, $res); |
2360
|
202
|
100
|
100
|
|
|
323
|
if ((scalar keys %{$resinfo->{remaining_locals}} == 0) && (scalar keys %{$resinfo->{remaining_statics}} == 0)) { |
|
202
|
100
|
|
|
|
883
|
|
|
191
|
|
|
|
|
730
|
|
2361
|
174
|
100
|
|
|
|
418
|
if ($res ne $res1) { |
2362
|
68
|
|
|
|
|
111
|
$res = $res1; |
2363
|
|
|
|
|
|
|
} |
2364
|
174
|
|
|
|
|
544
|
$resinfo = $ctx->get_unresolved_info($cmd, $res); |
2365
|
174
|
|
|
|
|
559
|
$unresolved_param = _find_unresolved_param($resinfo, $param); |
2366
|
28
|
|
|
|
|
122
|
} elsif (scalar keys %{$resinfo->{remaining_statics}} > 0) { |
2367
|
21
|
|
|
|
|
40
|
$keep_call = 1; |
2368
|
|
|
|
|
|
|
} else { |
2369
|
7
|
|
|
|
|
29
|
$unresolved_param = _find_unresolved_param($resinfo, $param); |
2370
|
|
|
|
|
|
|
} |
2371
|
|
|
|
|
|
|
|
2372
|
202
|
100
|
|
|
|
543
|
if ($is_construct) { |
2373
|
6
|
50
|
|
|
|
24
|
unless (_anon_func_call($parser, $res)) { |
2374
|
6
|
|
|
|
|
16
|
$res = _to_code_block($parser, $res); |
2375
|
|
|
|
|
|
|
} |
2376
|
6
|
50
|
|
|
|
22
|
$ctx->{log}->($ctx, 'func', $cmd, "return $res for void construct") if $ctx->{log}; |
2377
|
6
|
|
|
|
|
60
|
return ('#construct', $res); # return dummy result & show simplified code for construct |
2378
|
|
|
|
|
|
|
} |
2379
|
|
|
|
|
|
|
|
2380
|
|
|
|
|
|
|
# undefined result |
2381
|
|
|
|
|
|
|
# |
2382
|
196
|
100
|
100
|
|
|
783
|
if (defined $u || defined $f) { |
2383
|
20
|
100
|
|
|
|
83
|
if ($ctx2->{tainted} > $ctx->{tainted}) { |
2384
|
7
|
|
|
|
|
32
|
$ctx->{warn}->($ctx, 'func', $cmd, "not completely executed (and tainted)"); |
2385
|
7
|
|
|
|
|
293
|
$ctx->{tainted} = $ctx2->{tainted}; |
2386
|
|
|
|
|
|
|
} |
2387
|
|
|
|
|
|
|
} |
2388
|
|
|
|
|
|
|
|
2389
|
196
|
100
|
|
|
|
434
|
if (_can_return($resinfo)) { |
2390
|
130
|
50
|
|
|
|
300
|
if (!defined $r) { |
2391
|
0
|
0
|
0
|
|
|
0
|
if ($ctx->{infunction} && !$ctx->{incall}) { |
2392
|
0
|
0
|
|
|
|
0
|
$ctx->{log}->($ctx, 'func', $cmd, "don't expand subcalls while function is parsed") if $ctx->{log}; |
2393
|
0
|
|
|
|
|
0
|
return (undef, $res); |
2394
|
|
|
|
|
|
|
} |
2395
|
0
|
0
|
|
|
|
0
|
$ctx->{log}->($ctx, 'func', $cmd, "has return but no final return -> inline anon func") if $ctx->{log}; |
2396
|
0
|
|
|
|
|
0
|
$res = _to_anon_func_call($parser, $res); |
2397
|
0
|
|
|
|
|
0
|
return ('#notaint', $res); |
2398
|
|
|
|
|
|
|
} |
2399
|
130
|
|
|
|
|
323
|
my $arg = $parser->{strmap}->{$r}->[1]; |
2400
|
130
|
|
|
|
|
460
|
my $arginfo = {vars => {}, calls => {}, stmts => {}}; |
2401
|
130
|
|
|
|
|
445
|
$parser->stmt_info($arg, $arginfo); |
2402
|
|
|
|
|
|
|
|
2403
|
130
|
100
|
|
|
|
394
|
if ($ctx2->contains_local_var($arginfo)) { |
2404
|
4
|
100
|
66
|
|
|
18
|
if ($ctx->{infunction} && !$ctx->{incall}) { |
2405
|
2
|
50
|
|
|
|
7
|
$ctx->{log}->($ctx, 'func', $cmd, "don't expand subcalls while function is parsed") if $ctx->{log}; |
2406
|
2
|
|
|
|
|
28
|
return (undef, $res); |
2407
|
|
|
|
|
|
|
} |
2408
|
2
|
50
|
33
|
|
|
18
|
if ($keep_call || $unresolved_param) { |
2409
|
0
|
0
|
|
|
|
0
|
$ctx->{log}->($ctx, 'func', $cmd, "return $arg is local var & unresolved locals -> keep call") if $ctx->{log}; |
2410
|
0
|
|
|
|
|
0
|
return ('#notaint', undef); |
2411
|
|
|
|
|
|
|
} |
2412
|
2
|
50
|
|
|
|
9
|
$ctx->{log}->($ctx, 'func', $cmd, "return $arg is local var -> inline anon func") if $ctx->{log}; |
2413
|
2
|
|
|
|
|
10
|
$res = _to_anon_func_call($parser, $res); |
2414
|
2
|
|
|
|
|
37
|
return ('#notaint', $res); |
2415
|
|
|
|
|
|
|
} |
2416
|
126
|
|
|
|
|
452
|
$arg = $ctx2->convert_globals_to_caller_ctx($resinfo, $arg, $ctx); |
2417
|
|
|
|
|
|
|
|
2418
|
126
|
|
|
|
|
344
|
my $res1 = _remove_final_statement($parser, '(return)', $res); |
2419
|
|
|
|
|
|
|
|
2420
|
126
|
100
|
66
|
|
|
594
|
if ($keep_call || $unresolved_param) { |
2421
|
7
|
|
|
|
|
20
|
$resinfo = $ctx->get_unresolved_info($cmd, $res1); |
2422
|
7
|
50
|
|
|
|
28
|
if (_can_return($resinfo)) { |
2423
|
0
|
0
|
|
|
|
0
|
$ctx->{log}->($ctx, 'func', $cmd, "has multiple returns & unresolved locals -> keep call") if $ctx->{log}; |
2424
|
0
|
|
|
|
|
0
|
return ('#notaint', undef); |
2425
|
|
|
|
|
|
|
} else { |
2426
|
7
|
50
|
|
|
|
24
|
$ctx->{log}->($ctx, 'func', $cmd, "has return $arg & unresolved locals -> keep call") if $ctx->{log}; |
2427
|
7
|
|
|
|
|
79
|
return ($arg, undef); |
2428
|
|
|
|
|
|
|
} |
2429
|
|
|
|
|
|
|
} |
2430
|
119
|
50
|
|
|
|
345
|
if ($ctx2->can_inline($res1)) { |
2431
|
119
|
|
|
|
|
297
|
$res1 = $ctx2->convert_globals_to_caller_ctx($resinfo, $res1, $ctx); |
2432
|
119
|
|
|
|
|
1339
|
return ($arg, $res1); |
2433
|
|
|
|
|
|
|
} |
2434
|
0
|
0
|
|
|
|
0
|
$ctx->{log}->($ctx, 'func', $cmd, "has return $arg but can't inline -> inline anon func") if $ctx->{log}; |
2435
|
0
|
|
|
|
|
0
|
$res = _to_anon_func_call($parser, $res); |
2436
|
0
|
|
|
|
|
0
|
return ('#notaint', $res); |
2437
|
|
|
|
|
|
|
} |
2438
|
|
|
|
|
|
|
} else { |
2439
|
1
|
|
|
|
|
5
|
$unresolved_param = _find_unresolved_param($resinfo, $param); |
2440
|
|
|
|
|
|
|
} |
2441
|
|
|
|
|
|
|
|
2442
|
67
|
100
|
|
|
|
191
|
if (scalar @$out > 0) { |
2443
|
|
|
|
|
|
|
# If a return was omitted the value NULL will be returned. |
2444
|
|
|
|
|
|
|
# https://php.net/manual/en/functions.returning-values.php |
2445
|
|
|
|
|
|
|
# |
2446
|
66
|
50
|
|
|
|
150
|
$ctx->{log}->($ctx, 'func', $cmd, "has no return - return #null") if $ctx->{log}; |
2447
|
|
|
|
|
|
|
|
2448
|
66
|
100
|
100
|
|
|
259
|
if ($keep_call || $unresolved_param) { |
2449
|
12
|
|
|
|
|
130
|
return ('#noreturn', undef); |
2450
|
|
|
|
|
|
|
} |
2451
|
54
|
100
|
|
|
|
201
|
if ($ctx2->can_inline($res)) { |
2452
|
52
|
|
|
|
|
188
|
$res = $ctx2->convert_globals_to_caller_ctx($resinfo, $res, $ctx); |
2453
|
52
|
|
|
|
|
512
|
return ('#noreturn', $res); |
2454
|
|
|
|
|
|
|
} |
2455
|
2
|
|
|
|
|
13
|
$res = _to_anon_func_call($parser, $res); |
2456
|
2
|
|
|
|
|
59
|
return ('#noreturn', $res); |
2457
|
|
|
|
|
|
|
} |
2458
|
|
|
|
|
|
|
} |
2459
|
1
|
|
|
|
|
7
|
return; |
2460
|
|
|
|
|
|
|
} |
2461
|
|
|
|
|
|
|
|
2462
|
|
|
|
|
|
|
sub exec_func { |
2463
|
205
|
|
|
205
|
0
|
528
|
my ($ctx, $cmd, $arglist, $param, $block) = @_; |
2464
|
205
|
|
|
|
|
336
|
my $parser = $ctx->{parser}; |
2465
|
205
|
|
|
|
|
310
|
my $ret; |
2466
|
|
|
|
|
|
|
my $code; |
2467
|
|
|
|
|
|
|
|
2468
|
205
|
100
|
|
|
|
573
|
if (exists $parser->{strmap}{_CALL}{$cmd}) { |
2469
|
51
|
|
|
|
|
128
|
$parser->{strmap}{_CALL}{$cmd} += 1; |
2470
|
|
|
|
|
|
|
} else { |
2471
|
154
|
|
|
|
|
412
|
$parser->{strmap}{_CALL}{$cmd} = 1; |
2472
|
|
|
|
|
|
|
} |
2473
|
205
|
|
|
|
|
373
|
my $level = $parser->{strmap}{_CALL}{$cmd}; |
2474
|
|
|
|
|
|
|
|
2475
|
205
|
50
|
|
|
|
394
|
if ($level > 4) { |
2476
|
0
|
|
|
|
|
0
|
$ctx->{warn}->($ctx, 'func', $cmd, "max recursion level ($level) reached"); |
2477
|
|
|
|
|
|
|
} else { |
2478
|
205
|
|
|
|
|
558
|
($ret, $code) = $ctx->_exec_func($cmd, $arglist, $param, $block); |
2479
|
|
|
|
|
|
|
} |
2480
|
205
|
|
|
|
|
582
|
$parser->{strmap}{_CALL}{$cmd} -= 1; |
2481
|
|
|
|
|
|
|
|
2482
|
205
|
100
|
|
|
|
606
|
if (defined $ret) { |
2483
|
200
|
|
|
|
|
701
|
return ($ret, $code); |
2484
|
|
|
|
|
|
|
} |
2485
|
5
|
|
|
|
|
18
|
return; |
2486
|
|
|
|
|
|
|
} |
2487
|
|
|
|
|
|
|
|
2488
|
|
|
|
|
|
|
# get elem list for multidimensional array (base elem first) |
2489
|
|
|
|
|
|
|
# |
2490
|
|
|
|
|
|
|
sub _get_elemlist { |
2491
|
167
|
|
|
167
|
|
290
|
my ($parser, $var) = @_; |
2492
|
167
|
|
|
|
|
309
|
my @list = (); |
2493
|
|
|
|
|
|
|
|
2494
|
167
|
|
|
|
|
604
|
while ($var =~ /^#elem\d+$/) { |
2495
|
195
|
|
|
|
|
322
|
my ($v, $i) = @{$parser->{strmap}->{$var}}; |
|
195
|
|
|
|
|
482
|
|
2496
|
|
|
|
|
|
|
|
2497
|
195
|
|
|
|
|
441
|
unshift(@list, $var); |
2498
|
195
|
|
|
|
|
503
|
$var = $v; |
2499
|
|
|
|
|
|
|
} |
2500
|
167
|
|
|
|
|
391
|
return \@list; |
2501
|
|
|
|
|
|
|
} |
2502
|
|
|
|
|
|
|
|
2503
|
|
|
|
|
|
|
# convert elem list to point to new base var |
2504
|
|
|
|
|
|
|
# |
2505
|
|
|
|
|
|
|
sub _update_elemlist { |
2506
|
18
|
|
|
18
|
|
76
|
my ($parser, $var, $elemlist) = @_; |
2507
|
18
|
|
|
|
|
37
|
my @list = (); |
2508
|
|
|
|
|
|
|
|
2509
|
18
|
|
|
|
|
43
|
foreach my $elem (@$elemlist) { |
2510
|
24
|
|
|
|
|
36
|
my ($v, $i) = @{$parser->{strmap}->{$elem}}; |
|
24
|
|
|
|
|
62
|
|
2511
|
24
|
|
|
|
|
63
|
my $next = $parser->setelem($var, $i); |
2512
|
24
|
|
|
|
|
56
|
push(@list, $next); |
2513
|
24
|
|
|
|
|
52
|
$var = $next; |
2514
|
|
|
|
|
|
|
} |
2515
|
18
|
|
|
|
|
86
|
return \@list; |
2516
|
|
|
|
|
|
|
} |
2517
|
|
|
|
|
|
|
|
2518
|
|
|
|
|
|
|
sub resolve_varvar { |
2519
|
55
|
|
|
55
|
0
|
123
|
my ($ctx, $var, $in_block) = @_; |
2520
|
55
|
|
|
|
|
108
|
my $parser = $ctx->{parser}; |
2521
|
|
|
|
|
|
|
|
2522
|
|
|
|
|
|
|
# https://www.php.net/manual/en/language.variables.variable.php |
2523
|
|
|
|
|
|
|
# |
2524
|
55
|
50
|
|
|
|
163
|
if ($var =~ /^#expr\d+$/) { |
2525
|
55
|
|
|
|
|
87
|
my ($op, $v1, $v2) = @{$parser->{strmap}->{$var}}; |
|
55
|
|
|
|
|
148
|
|
2526
|
|
|
|
|
|
|
|
2527
|
55
|
50
|
66
|
|
|
259
|
if (($op eq '$') && !defined $v1 && defined $v2) { |
|
|
|
66
|
|
|
|
|
2528
|
42
|
|
|
|
|
125
|
my $op2 = $ctx->exec_statement($v2, $in_block); |
2529
|
42
|
|
|
|
|
150
|
my $val = $parser->varvar_to_var($op2); |
2530
|
42
|
100
|
|
|
|
119
|
if (defined $val) { |
2531
|
37
|
|
|
|
|
107
|
return $val; |
2532
|
|
|
|
|
|
|
} |
2533
|
5
|
100
|
|
|
|
23
|
if ($v2 ne $op2) { |
2534
|
|
|
|
|
|
|
# simplify expr |
2535
|
2
|
|
|
|
|
18
|
$val = $parser->setexpr($op, undef, $op2); |
2536
|
2
|
|
|
|
|
15
|
return $val; |
2537
|
|
|
|
|
|
|
} |
2538
|
|
|
|
|
|
|
} |
2539
|
|
|
|
|
|
|
} |
2540
|
16
|
|
|
|
|
37
|
return $var; |
2541
|
|
|
|
|
|
|
} |
2542
|
|
|
|
|
|
|
|
2543
|
|
|
|
|
|
|
sub resolve_obj { |
2544
|
65
|
|
|
65
|
0
|
148
|
my ($ctx, $var, $in_block) = @_; |
2545
|
65
|
|
|
|
|
105
|
my $parser = $ctx->{parser}; |
2546
|
|
|
|
|
|
|
|
2547
|
65
|
50
|
|
|
|
208
|
if ($var =~ /^#obj\d+$/) { |
2548
|
65
|
|
|
|
|
102
|
my ($o, $m) = @{$parser->{strmap}->{$var}}; |
|
65
|
|
|
|
|
160
|
|
2549
|
|
|
|
|
|
|
|
2550
|
65
|
50
|
|
|
|
149
|
if ($o =~ /^#inst\d+$/) { |
2551
|
0
|
|
|
|
|
0
|
$ctx->{warn}->($ctx, 'resolve', $var, "obj already instanciated $o"); |
2552
|
|
|
|
|
|
|
} |
2553
|
65
|
|
|
|
|
163
|
my ($basevar, $has_index, $idxstr) = $ctx->resolve_variable($o, $in_block); |
2554
|
65
|
|
|
|
|
115
|
my $basestr; |
2555
|
65
|
100
|
100
|
|
|
255
|
if (defined $basevar && !$has_index) { |
|
|
50
|
|
|
|
|
|
2556
|
50
|
|
|
|
|
127
|
$basestr = $ctx->exec_statement($basevar, $in_block); |
2557
|
50
|
100
|
|
|
|
162
|
if ($basestr ne $basevar) { |
2558
|
29
|
0
|
|
|
|
98
|
$ctx->{log}->($ctx, 'resolve', $var, "obj-var $o basevar $basevar [%s]", defined $basestr ? $basestr : '') if $ctx->{log}; |
|
|
50
|
|
|
|
|
|
2559
|
|
|
|
|
|
|
} |
2560
|
|
|
|
|
|
|
} elsif ($o =~ /^#inst\d+$/) { |
2561
|
0
|
0
|
|
|
|
0
|
$ctx->{log}->($ctx, 'resolve', $var, "has inst $o") if $ctx->{log}; |
2562
|
0
|
|
|
|
|
0
|
$basestr = $o; |
2563
|
|
|
|
|
|
|
} |
2564
|
65
|
100
|
|
|
|
148
|
if (!defined $basestr) { |
2565
|
15
|
|
|
|
|
39
|
my $inst = $ctx->exec_statement($o); |
2566
|
15
|
100
|
|
|
|
47
|
if ($inst ne $o) { |
2567
|
13
|
50
|
|
|
|
39
|
$ctx->{log}->($ctx, 'resolve', $var, "created $inst") if $ctx->{log}; |
2568
|
13
|
|
|
|
|
24
|
$basestr = $inst; |
2569
|
|
|
|
|
|
|
} |
2570
|
|
|
|
|
|
|
} |
2571
|
65
|
0
|
|
|
|
148
|
$ctx->{log}->($ctx, 'resolve', $var, "[$o->$m] -> %s", defined $basestr ? $basestr : '-') if $ctx->{log}; |
|
|
50
|
|
|
|
|
|
2572
|
|
|
|
|
|
|
|
2573
|
65
|
100
|
100
|
|
|
341
|
if (defined $basestr && ($basestr =~ /^#inst\d+$/)) { |
2574
|
40
|
|
|
|
|
66
|
my $inst = $basestr; |
2575
|
40
|
|
|
|
|
63
|
my $sym = $m; |
2576
|
|
|
|
|
|
|
|
2577
|
|
|
|
|
|
|
# $obj->{'a'}() or $obj->{$x}() is allowed |
2578
|
|
|
|
|
|
|
# |
2579
|
40
|
100
|
66
|
|
|
91
|
if (is_block($m) || is_variable($m)) { |
2580
|
1
|
|
|
|
|
18
|
$sym = $ctx->exec_statement($m); |
2581
|
|
|
|
|
|
|
} |
2582
|
40
|
100
|
66
|
|
|
89
|
if (is_strval($sym) && !is_null($sym)) { |
2583
|
1
|
|
|
|
|
17
|
$sym = $parser->{strmap}{$sym}; |
2584
|
1
|
50
|
|
|
|
7
|
$ctx->{log}->($ctx, 'resolve', $var, "resolved sym $o :: $m -> $inst :: $sym") if $ctx->{log}; |
2585
|
|
|
|
|
|
|
} |
2586
|
40
|
|
|
|
|
188
|
return ($inst, $sym); |
2587
|
|
|
|
|
|
|
} |
2588
|
|
|
|
|
|
|
} |
2589
|
25
|
|
|
|
|
93
|
return; |
2590
|
|
|
|
|
|
|
} |
2591
|
|
|
|
|
|
|
|
2592
|
|
|
|
|
|
|
sub resolve_scope { |
2593
|
49
|
|
|
49
|
0
|
103
|
my ($ctx, $var, $in_block) = @_; |
2594
|
49
|
|
|
|
|
85
|
my $parser = $ctx->{parser}; |
2595
|
|
|
|
|
|
|
|
2596
|
|
|
|
|
|
|
# https://php.net/manual/en/language.oop5.paamayim-nekudotayim.php |
2597
|
|
|
|
|
|
|
# |
2598
|
49
|
50
|
|
|
|
154
|
if ($var =~ /^#scope\d+$/) { |
2599
|
49
|
|
|
|
|
75
|
my ($c, $e) = @{$parser->{strmap}->{$var}}; |
|
49
|
|
|
|
|
123
|
|
2600
|
49
|
|
|
|
|
92
|
my $class; |
2601
|
|
|
|
|
|
|
my $scopename; |
2602
|
|
|
|
|
|
|
|
2603
|
49
|
50
|
|
|
|
104
|
if ($c =~ /^#class\d+$/) { |
2604
|
0
|
|
|
|
|
0
|
$ctx->{warn}->($ctx, 'resolve', $var, "scope already resolved $c"); |
2605
|
0
|
|
|
|
|
0
|
$class = $c; |
2606
|
|
|
|
|
|
|
} else { |
2607
|
49
|
|
|
|
|
78
|
my $name = $c; |
2608
|
49
|
100
|
|
|
|
124
|
if (!is_symbol($name)) { |
2609
|
1
|
|
|
|
|
6
|
my $s = $ctx->exec_statement($name); |
2610
|
1
|
50
|
33
|
|
|
5
|
if (is_strval($s) && !is_null($s)) { |
2611
|
0
|
|
|
|
|
0
|
$name = $parser->{strmap}->{$s}; |
2612
|
|
|
|
|
|
|
} else { |
2613
|
1
|
|
|
|
|
3
|
$name = $s; |
2614
|
|
|
|
|
|
|
} |
2615
|
1
|
50
|
|
|
|
4
|
$ctx->{log}->($ctx, 'resolve', $var, "map %s (%s) -> %s", $c, $s, $name) if $ctx->{log}; |
2616
|
|
|
|
|
|
|
} |
2617
|
49
|
100
|
|
|
|
151
|
if ($name eq 'self') { |
|
|
50
|
|
|
|
|
|
2618
|
3
|
50
|
|
|
|
15
|
if (exists $ctx->{class_scope}) { |
2619
|
3
|
|
|
|
|
11
|
$class = $ctx->getclass($ctx->{class_scope}); |
2620
|
|
|
|
|
|
|
} else { |
2621
|
0
|
|
|
|
|
0
|
$ctx->{warn}->($ctx, 'resolve', $var, "self used outside of class scope"); |
2622
|
|
|
|
|
|
|
} |
2623
|
|
|
|
|
|
|
} elsif ($name eq 'parent') { |
2624
|
0
|
0
|
|
|
|
0
|
if (exists $ctx->{class_scope}) { |
2625
|
0
|
|
|
|
|
0
|
$ctx->{warn}->($ctx, 'resolve', $var, "parent for class $ctx->{class_scope} not supported"); |
2626
|
|
|
|
|
|
|
} else { |
2627
|
0
|
|
|
|
|
0
|
$ctx->{warn}->($ctx, 'resolve', $var, "parent used outside of class scope"); |
2628
|
|
|
|
|
|
|
} |
2629
|
|
|
|
|
|
|
} else { |
2630
|
46
|
|
|
|
|
103
|
$scopename = $ctx->add_namespace($name); |
2631
|
46
|
|
|
|
|
132
|
$class = $ctx->getclass($scopename); |
2632
|
|
|
|
|
|
|
} |
2633
|
|
|
|
|
|
|
} |
2634
|
49
|
100
|
|
|
|
116
|
if (defined $class) { |
2635
|
46
|
|
|
|
|
60
|
my ($n, $b, $p) = @{$parser->{strmap}->{$class}}; |
|
46
|
|
|
|
|
128
|
|
2636
|
|
|
|
|
|
|
|
2637
|
46
|
100
|
|
|
|
104
|
$scopename = $n unless defined $scopename; |
2638
|
|
|
|
|
|
|
|
2639
|
46
|
100
|
|
|
|
109
|
if (is_variable($e)) { |
2640
|
22
|
|
|
|
|
58
|
my ($basevar, $has_index, $idxstr) = $ctx->resolve_variable($e, $in_block); |
2641
|
22
|
50
|
33
|
|
|
62
|
if (defined $basevar && is_variable($basevar)) { |
2642
|
22
|
50
|
|
|
|
45
|
$ctx->{log}->($ctx, 'resolve', $var, "var %s::%s -> %s::%s", $c, $e, $scopename, $basevar) if $ctx->{log}; |
2643
|
22
|
|
|
|
|
97
|
return ($scopename, $basevar); |
2644
|
|
|
|
|
|
|
} |
2645
|
|
|
|
|
|
|
} else { |
2646
|
24
|
|
|
|
|
63
|
my $sym = $e; |
2647
|
24
|
50
|
|
|
|
49
|
if (is_block($e)) { |
2648
|
0
|
|
|
|
|
0
|
$sym = $ctx->exec_statement($e); |
2649
|
|
|
|
|
|
|
} |
2650
|
24
|
50
|
33
|
|
|
54
|
if (is_strval($sym) && !is_null($sym)) { |
2651
|
0
|
|
|
|
|
0
|
$sym = $parser->{strmap}{$sym}; |
2652
|
0
|
0
|
|
|
|
0
|
$ctx->{log}->($ctx, 'resolve', $var, "sym %s::%s -> %s::%s", $c, $e, $scopename, $sym) if $ctx->{log}; |
2653
|
|
|
|
|
|
|
} |
2654
|
24
|
|
|
|
|
91
|
return ($scopename, $sym); |
2655
|
|
|
|
|
|
|
} |
2656
|
|
|
|
|
|
|
} |
2657
|
|
|
|
|
|
|
} |
2658
|
3
|
|
|
|
|
10
|
return; |
2659
|
|
|
|
|
|
|
} |
2660
|
|
|
|
|
|
|
|
2661
|
|
|
|
|
|
|
sub resolve_ns { |
2662
|
11
|
|
|
11
|
0
|
20
|
my ($ctx, $var, $in_block) = @_; |
2663
|
11
|
|
|
|
|
16
|
my $parser = $ctx->{parser}; |
2664
|
|
|
|
|
|
|
|
2665
|
|
|
|
|
|
|
# https://php.net/manual/en/language.namespaces.rationale.php |
2666
|
|
|
|
|
|
|
# |
2667
|
11
|
50
|
|
|
|
40
|
if ($var =~ /^#ns\d+$/) { |
2668
|
11
|
|
|
|
|
18
|
my ($n, $e) = @{$parser->{strmap}->{$var}}; |
|
11
|
|
|
|
|
24
|
|
2669
|
11
|
|
|
|
|
15
|
my $ns; |
2670
|
|
|
|
|
|
|
|
2671
|
11
|
100
|
|
|
|
32
|
if (!defined $n) { |
2672
|
7
|
50
|
|
|
|
16
|
$ctx->{log}->($ctx, 'resolve', $var, "toplevel") if $ctx->{log}; |
2673
|
7
|
|
|
|
|
10
|
$ns = ''; # toplevel |
2674
|
|
|
|
|
|
|
} else { |
2675
|
4
|
|
|
|
|
6
|
my $name = $n; |
2676
|
4
|
50
|
|
|
|
13
|
if (!is_symbol($name)) { |
2677
|
4
|
|
|
|
|
9
|
my $s = $ctx->exec_statement($name); |
2678
|
4
|
50
|
33
|
|
|
10
|
if (is_strval($s) && !is_null($s)) { |
2679
|
0
|
|
|
|
|
0
|
$name = $parser->{strmap}->{$s}; |
2680
|
|
|
|
|
|
|
} else { |
2681
|
4
|
|
|
|
|
8
|
$name = $s; |
2682
|
|
|
|
|
|
|
} |
2683
|
4
|
50
|
|
|
|
11
|
$ctx->{log}->($ctx, 'resolve', $var, "map %s (%s) -> %s", $n, $e, $name) if $ctx->{log}; |
2684
|
|
|
|
|
|
|
} |
2685
|
4
|
50
|
|
|
|
10
|
if ($name eq 'namespace') { |
2686
|
0
|
|
|
|
|
0
|
$ns = lc($ctx->{namespace}); |
2687
|
|
|
|
|
|
|
} else { |
2688
|
4
|
|
|
|
|
23
|
$ns = $name; |
2689
|
|
|
|
|
|
|
} |
2690
|
|
|
|
|
|
|
} |
2691
|
11
|
|
|
|
|
46
|
return ($ns, $e); |
2692
|
|
|
|
|
|
|
} |
2693
|
0
|
|
|
|
|
0
|
return; |
2694
|
|
|
|
|
|
|
} |
2695
|
|
|
|
|
|
|
|
2696
|
|
|
|
|
|
|
# convert first elem of elem list to variable if possible |
2697
|
|
|
|
|
|
|
# |
2698
|
|
|
|
|
|
|
sub get_baseelem { |
2699
|
164
|
|
|
164
|
0
|
315
|
my ($ctx, $var, $in_block) = @_; |
2700
|
164
|
|
|
|
|
304
|
my $parser = $ctx->{parser}; |
2701
|
164
|
|
|
|
|
418
|
my $elemlist = _get_elemlist($parser, $var); |
2702
|
|
|
|
|
|
|
|
2703
|
164
|
50
|
|
|
|
586
|
if ($elemlist->[0] =~ /^#elem\d+$/) { |
2704
|
164
|
|
|
|
|
262
|
my ($v, $i) = @{$parser->{strmap}->{$elemlist->[0]}}; |
|
164
|
|
|
|
|
423
|
|
2705
|
|
|
|
|
|
|
|
2706
|
164
|
100
|
66
|
|
|
678
|
if (defined $i && ($v !~ /^#elem\d+$/)) { |
2707
|
|
|
|
|
|
|
# allow only to resolve variable recursively |
2708
|
|
|
|
|
|
|
# todo: use resolve_variable() here? |
2709
|
|
|
|
|
|
|
# |
2710
|
140
|
|
|
|
|
219
|
my $val; |
2711
|
140
|
100
|
|
|
|
374
|
if ($v =~ /^#expr\d+$/) { |
|
|
100
|
|
|
|
|
|
2712
|
2
|
|
|
|
|
15
|
$val = $ctx->resolve_varvar($v, $in_block); |
2713
|
2
|
50
|
33
|
|
|
10
|
if (($val ne $v) && !is_variable($val)) { |
2714
|
0
|
|
|
|
|
0
|
return _update_elemlist($parser, $val, $elemlist); |
2715
|
|
|
|
|
|
|
} |
2716
|
|
|
|
|
|
|
} elsif ($v =~ /^#obj\d+$/) { |
2717
|
4
|
|
|
|
|
15
|
my ($inst, $prop) = $ctx->resolve_obj($v, $in_block); |
2718
|
4
|
100
|
|
|
|
18
|
if (defined $inst) { |
2719
|
2
|
|
|
|
|
9
|
$val = inst_var($inst, '$'.$prop); |
2720
|
|
|
|
|
|
|
} |
2721
|
|
|
|
|
|
|
} else { |
2722
|
134
|
|
|
|
|
309
|
$val = $ctx->exec_statement($v, $in_block); |
2723
|
|
|
|
|
|
|
} |
2724
|
140
|
100
|
100
|
|
|
717
|
if (defined $val && is_variable($val)) { |
2725
|
65
|
|
|
|
|
232
|
my $idx = $ctx->exec_statement($i); |
2726
|
65
|
|
|
|
|
278
|
my $g = $parser->globalvar_to_var($val, $idx); |
2727
|
65
|
100
|
|
|
|
283
|
if (defined $g) { |
|
|
100
|
|
|
|
|
|
2728
|
|
|
|
|
|
|
# convert resolved basevar $GLOBALS['x'] -> $x, |
2729
|
|
|
|
|
|
|
# |
2730
|
30
|
100
|
|
|
|
96
|
if ($ctx->{infunction}) { |
2731
|
13
|
|
|
|
|
37
|
$g = global_var($g); |
2732
|
|
|
|
|
|
|
} |
2733
|
30
|
|
|
|
|
67
|
shift(@$elemlist); |
2734
|
30
|
100
|
|
|
|
70
|
if (@$elemlist) { |
2735
|
4
|
|
|
|
|
23
|
return _update_elemlist($parser, $g, $elemlist); |
2736
|
|
|
|
|
|
|
} else { |
2737
|
26
|
|
|
|
|
105
|
return [$g]; |
2738
|
|
|
|
|
|
|
} |
2739
|
|
|
|
|
|
|
} elsif ($ctx->is_superglobal($val)) { |
2740
|
21
|
|
|
|
|
69
|
return $elemlist; |
2741
|
|
|
|
|
|
|
} else { |
2742
|
|
|
|
|
|
|
# convert resolved baseelem ${$a}['x'] -> $b['x'], |
2743
|
|
|
|
|
|
|
# |
2744
|
14
|
|
|
|
|
67
|
return _update_elemlist($parser, $val, $elemlist); |
2745
|
|
|
|
|
|
|
} |
2746
|
|
|
|
|
|
|
} |
2747
|
|
|
|
|
|
|
} |
2748
|
|
|
|
|
|
|
} |
2749
|
99
|
|
|
|
|
239
|
return $elemlist; |
2750
|
|
|
|
|
|
|
} |
2751
|
|
|
|
|
|
|
|
2752
|
|
|
|
|
|
|
# For undefined multidimensional arrays create_basearray() allocates |
2753
|
|
|
|
|
|
|
# missing intermediate arrays. Also assigns a new array or a copy of |
2754
|
|
|
|
|
|
|
# the existing array via setvar() to basevar. |
2755
|
|
|
|
|
|
|
# |
2756
|
|
|
|
|
|
|
# return: ($var, $val, $basevar); |
2757
|
|
|
|
|
|
|
# - var: the variable part for the topmost element (topmost index ignored) |
2758
|
|
|
|
|
|
|
# - val: the matching (sub)-array for this variable (might be undef) |
2759
|
|
|
|
|
|
|
# - basevar: the base variable of the array. |
2760
|
|
|
|
|
|
|
# |
2761
|
|
|
|
|
|
|
sub create_basearray { |
2762
|
123
|
|
|
123
|
0
|
247
|
my ($ctx, $elemlist, $in_block) = @_; |
2763
|
123
|
|
|
|
|
230
|
my $parser = $ctx->{parser}; |
2764
|
123
|
|
|
|
|
305
|
my $superglobals_writable = 1; |
2765
|
|
|
|
|
|
|
|
2766
|
123
|
|
|
|
|
209
|
my $elem = $elemlist->[0]; |
2767
|
123
|
|
|
|
|
237
|
my ($v, $i) = @{$parser->{strmap}->{$elem}}; |
|
123
|
|
|
|
|
348
|
|
2768
|
123
|
|
|
|
|
291
|
my $val = $ctx->exec_statement($v, $in_block); |
2769
|
123
|
|
|
|
|
255
|
my $basevar = $v; |
2770
|
|
|
|
|
|
|
|
2771
|
123
|
100
|
|
|
|
324
|
if (is_variable($val)) { |
2772
|
|
|
|
|
|
|
# resolved reference |
2773
|
29
|
50
|
66
|
|
|
95
|
if (!$ctx->is_superglobal($val) || $superglobals_writable) { |
2774
|
29
|
|
|
|
|
74
|
$v = $val; |
2775
|
29
|
|
|
|
|
59
|
$val = undef; |
2776
|
|
|
|
|
|
|
} |
2777
|
|
|
|
|
|
|
} |
2778
|
123
|
100
|
100
|
|
|
405
|
if (defined $val && is_strval($val) && ($parser->get_strval_or_str($val) eq '')) { |
|
|
|
100
|
|
|
|
|
2779
|
|
|
|
|
|
|
# up to php70 empty strings are treated like an empty array |
2780
|
|
|
|
|
|
|
# https://www.php.net/manual/en/migration71.incompatible.php |
2781
|
|
|
|
|
|
|
# |
2782
|
38
|
50
|
|
|
|
125
|
unless (exists $ctx->{skip}{treat_empty_str_like_empty_array}) { |
2783
|
38
|
|
|
|
|
201
|
$ctx->{warn}->($ctx, 'elem', $elem, "treat empty str $val like empty array"); |
2784
|
38
|
|
|
|
|
2914
|
$val = undef; |
2785
|
|
|
|
|
|
|
} |
2786
|
|
|
|
|
|
|
} |
2787
|
123
|
50
|
66
|
|
|
433
|
if (defined $val && is_null($val)) { |
2788
|
0
|
|
|
|
|
0
|
$val = undef; |
2789
|
|
|
|
|
|
|
} |
2790
|
123
|
100
|
100
|
|
|
399
|
if (!defined $val || is_array($val)) { |
2791
|
119
|
100
|
|
|
|
251
|
if (!defined $val) { |
2792
|
|
|
|
|
|
|
# nonexisting array is auto-created |
2793
|
|
|
|
|
|
|
# |
2794
|
67
|
|
|
|
|
247
|
my $arr = $parser->newarr(); |
2795
|
67
|
|
|
|
|
158
|
$val = $arr->{name}; |
2796
|
67
|
50
|
|
|
|
180
|
$ctx->{log}->($ctx, 'elem', $elem, "create_base autoarr $v: $val") if $ctx->{log}; |
2797
|
|
|
|
|
|
|
} else { |
2798
|
|
|
|
|
|
|
# TODO: don't copy array if not displayed since last update |
2799
|
|
|
|
|
|
|
# (track tainted state for each array) |
2800
|
|
|
|
|
|
|
# |
2801
|
52
|
|
|
|
|
123
|
my $arr = $parser->{strmap}{$val}; |
2802
|
52
|
|
|
|
|
195
|
$arr = $arr->copy(); # recursive copy |
2803
|
52
|
50
|
|
|
|
131
|
$ctx->{log}->($ctx, 'elem', $elem, "create_base copyarr $v: $val -> $arr->{name}") if $ctx->{log}; |
2804
|
52
|
|
|
|
|
115
|
$val = $arr->{name}; |
2805
|
|
|
|
|
|
|
} |
2806
|
|
|
|
|
|
|
# don't insert '$x = array()' into block |
2807
|
|
|
|
|
|
|
# |
2808
|
119
|
|
|
|
|
341
|
$ctx->setvar($v, $val, 1); |
2809
|
|
|
|
|
|
|
#$ctx->setvar($v, $val, $in_block); |
2810
|
|
|
|
|
|
|
} else { |
2811
|
|
|
|
|
|
|
# something like #obj? |
2812
|
|
|
|
|
|
|
# |
2813
|
4
|
|
|
|
|
9
|
my $lastelem = $elemlist->[-1]; |
2814
|
4
|
|
|
|
|
8
|
my ($lastvar, $lastidx) = @{$parser->{strmap}->{$lastelem}}; |
|
4
|
|
|
|
|
22
|
|
2815
|
4
|
|
|
|
|
24
|
return ($lastvar, $val, $basevar); |
2816
|
|
|
|
|
|
|
} |
2817
|
|
|
|
|
|
|
|
2818
|
|
|
|
|
|
|
# resolve next index |
2819
|
|
|
|
|
|
|
# |
2820
|
119
|
|
|
|
|
502
|
foreach my $nextelem (@$elemlist[1..@$elemlist-1]) { |
2821
|
22
|
|
|
|
|
60
|
my $idx; |
2822
|
|
|
|
|
|
|
my $nextval; |
2823
|
22
|
|
|
|
|
42
|
my $arr = $parser->{strmap}{$val}; |
2824
|
|
|
|
|
|
|
|
2825
|
22
|
50
|
|
|
|
55
|
if (defined $i) { |
2826
|
22
|
|
|
|
|
81
|
$idx = $ctx->exec_statement($i, $in_block); |
2827
|
22
|
100
|
|
|
|
61
|
$idx = $parser->setstr('') if is_null($idx); # null maps to '' array index |
2828
|
22
|
|
|
|
|
108
|
my $arrval = $arr->get($idx); |
2829
|
22
|
100
|
|
|
|
79
|
if (defined $arrval) { |
2830
|
4
|
|
|
|
|
8
|
$nextval = $arrval; |
2831
|
|
|
|
|
|
|
} |
2832
|
|
|
|
|
|
|
} |
2833
|
22
|
100
|
100
|
|
|
72
|
if (!defined $nextval || is_array($nextval)) { |
2834
|
21
|
100
|
|
|
|
54
|
if (!defined $nextval) { |
2835
|
|
|
|
|
|
|
# nonexisting intermediate array is auto-created |
2836
|
|
|
|
|
|
|
# |
2837
|
18
|
|
|
|
|
45
|
my $newarr = $parser->newarr(); |
2838
|
18
|
50
|
|
|
|
70
|
$ctx->{log}->($ctx, 'elem', $elem, "create_base autoarr $nextelem: = $newarr->{name} [basevar: $basevar]") if $ctx->{log}; |
2839
|
18
|
|
|
|
|
35
|
$nextval = $newarr->{name}; |
2840
|
|
|
|
|
|
|
} |
2841
|
21
|
50
|
|
|
|
87
|
if (!defined $idx) { |
|
|
50
|
|
|
|
|
|
2842
|
0
|
|
|
|
|
0
|
$arr->set(undef, $nextval); |
2843
|
0
|
0
|
|
|
|
0
|
$ctx->{log}->($ctx, 'elem', $elem, "create_base set: %s[] = %s", $val, $nextval) if $ctx->{log}; |
2844
|
|
|
|
|
|
|
} elsif (is_strval($idx)) { |
2845
|
21
|
|
|
|
|
75
|
$arr->set($idx, $nextval); |
2846
|
21
|
50
|
|
|
|
82
|
$ctx->{log}->($ctx, 'elem', $elem, "create_base set: %s[%s] = %s", $val, $idx, $nextval) if $ctx->{log}; |
2847
|
|
|
|
|
|
|
} else { |
2848
|
0
|
0
|
|
|
|
0
|
$ctx->{log}->($ctx, 'elem', $elem, "create_base set: %s[%s] bad idx", $val, $idx) if $ctx->{log}; |
2849
|
|
|
|
|
|
|
} |
2850
|
|
|
|
|
|
|
} |
2851
|
22
|
50
|
33
|
|
|
83
|
if (($elem ne $v) || ($idx ne $i)) { |
2852
|
22
|
|
|
|
|
67
|
$elem = $parser->setelem($v, $idx); |
2853
|
|
|
|
|
|
|
} |
2854
|
22
|
|
|
|
|
71
|
$v = $elem; |
2855
|
22
|
|
|
|
|
40
|
$val = $nextval; |
2856
|
22
|
|
|
|
|
32
|
($elem, $i) = @{$parser->{strmap}->{$nextelem}}; |
|
22
|
|
|
|
|
72
|
|
2857
|
|
|
|
|
|
|
} |
2858
|
119
|
|
|
|
|
421
|
return ($v, $val, $basevar); |
2859
|
|
|
|
|
|
|
} |
2860
|
|
|
|
|
|
|
|
2861
|
|
|
|
|
|
|
# resolve_variable() returns: ($basevar, $has_idx, [$baseidx]) |
2862
|
|
|
|
|
|
|
# - basevar: resolved variable name (a.e: array name) |
2863
|
|
|
|
|
|
|
# - has_idx: is array dereference |
2864
|
|
|
|
|
|
|
# - baseidx: if is array: indexvalue of last index or undef if index is empty |
2865
|
|
|
|
|
|
|
# |
2866
|
|
|
|
|
|
|
sub resolve_variable { |
2867
|
180
|
|
|
180
|
1
|
384
|
my ($ctx, $var, $in_block) = @_; |
2868
|
180
|
|
|
|
|
309
|
my $parser = $ctx->{parser}; |
2869
|
|
|
|
|
|
|
|
2870
|
|
|
|
|
|
|
# returns: <$resolved_var> |
2871
|
|
|
|
|
|
|
# |
2872
|
180
|
50
|
|
|
|
423
|
if (!defined $var) { |
2873
|
0
|
|
|
|
|
0
|
$ctx->{warn}->($ctx, 'resolve', '', ""); |
2874
|
0
|
|
|
|
|
0
|
return; |
2875
|
|
|
|
|
|
|
} |
2876
|
180
|
100
|
|
|
|
393
|
if (is_variable($var)) { |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
2877
|
124
|
50
|
|
|
|
329
|
if (exists $ctx->{varmap}{ref}{$var}) { |
2878
|
0
|
|
|
|
|
0
|
my ($ctx2, $var1) = @{$ctx->{varmap}{ref}{$var}}; |
|
0
|
|
|
|
|
0
|
|
2879
|
|
|
|
|
|
|
# special case for '$var = &$GLOBALS' reference |
2880
|
0
|
0
|
|
|
|
0
|
if ($var1 =~ /^\$GLOBALS$/) { |
2881
|
0
|
0
|
|
|
|
0
|
$ctx->{log}->($ctx, 'resolve', $var, "superglobals reference -> $var1") if $ctx->{log}; |
2882
|
0
|
|
|
|
|
0
|
return $ctx2->resolve_variable($var1, $in_block); |
2883
|
|
|
|
|
|
|
} |
2884
|
|
|
|
|
|
|
} |
2885
|
124
|
|
|
|
|
430
|
return ($var, 0); |
2886
|
|
|
|
|
|
|
} elsif ($var =~ /^#obj\d+$/) { |
2887
|
0
|
|
|
|
|
0
|
my ($inst, $prop) = $ctx->resolve_obj($var, $in_block); |
2888
|
0
|
0
|
|
|
|
0
|
if (defined $inst) { |
2889
|
0
|
|
|
|
|
0
|
my $instvar = inst_var($inst, '$'.$prop); |
2890
|
0
|
0
|
|
|
|
0
|
$ctx->{log}->($ctx, 'resolve', $var, "obj -> $instvar") if $ctx->{log}; |
2891
|
0
|
|
|
|
|
0
|
return $ctx->resolve_variable($instvar, $in_block); |
2892
|
|
|
|
|
|
|
} |
2893
|
|
|
|
|
|
|
} elsif ($var =~ /^#scope\d+$/) { |
2894
|
0
|
|
|
|
|
0
|
my ($scope, $val) = $ctx->resolve_scope($var, $in_block); |
2895
|
0
|
0
|
0
|
|
|
0
|
if (defined $scope && is_variable($val)) { |
2896
|
0
|
|
|
|
|
0
|
my $classvar = inst_var($scope, $val); |
2897
|
0
|
0
|
|
|
|
0
|
$ctx->{log}->($ctx, 'resolve', $var, "scope -> $classvar") if $ctx->{log}; |
2898
|
0
|
|
|
|
|
0
|
return $ctx->resolve_variable($classvar, $in_block); |
2899
|
|
|
|
|
|
|
} |
2900
|
|
|
|
|
|
|
} elsif ($var =~ /^#elem\d+$/) { |
2901
|
16
|
|
|
|
|
28
|
my ($v, $i) = @{$parser->{strmap}->{$var}}; |
|
16
|
|
|
|
|
46
|
|
2902
|
|
|
|
|
|
|
|
2903
|
16
|
50
|
|
|
|
43
|
if (!defined $v) { |
2904
|
0
|
|
|
|
|
0
|
$ctx->{warn}->($ctx, 'resolve', $var, "BAD ELEM"); |
2905
|
0
|
|
|
|
|
0
|
return; |
2906
|
|
|
|
|
|
|
} |
2907
|
16
|
50
|
|
|
|
42
|
if (is_strval($v)) { |
2908
|
|
|
|
|
|
|
# #strliteral[#num] -> substring |
2909
|
|
|
|
|
|
|
# |
2910
|
0
|
|
|
|
|
0
|
my $idxstr = $ctx->exec_statement($i); |
2911
|
0
|
0
|
|
|
|
0
|
if (defined $idxstr) { |
2912
|
0
|
0
|
|
|
|
0
|
$ctx->{log}->($ctx, 'resolve', $var, "%s[%s] -> is substring", $v, $idxstr) if $ctx->{log}; |
2913
|
0
|
|
|
|
|
0
|
return ($v, 1, $idxstr); |
2914
|
|
|
|
|
|
|
} |
2915
|
|
|
|
|
|
|
} |
2916
|
16
|
50
|
|
|
|
44
|
if (is_array($v)) { |
2917
|
|
|
|
|
|
|
# #arr[#num] -> elem |
2918
|
|
|
|
|
|
|
# |
2919
|
0
|
|
|
|
|
0
|
my $idxstr = $ctx->exec_statement($i); |
2920
|
0
|
0
|
|
|
|
0
|
if (defined $idxstr) { |
2921
|
0
|
0
|
|
|
|
0
|
$ctx->{log}->($ctx, 'resolve', $var, "%s[%s] -> is array elem", $v, $idxstr) if $ctx->{log}; |
2922
|
0
|
|
|
|
|
0
|
return ($v, 1, $idxstr); |
2923
|
|
|
|
|
|
|
} |
2924
|
|
|
|
|
|
|
} |
2925
|
16
|
|
|
|
|
48
|
my $elemlist = $ctx->get_baseelem($var, $in_block); |
2926
|
16
|
|
|
|
|
60
|
my $basevar = $elemlist->[0]; |
2927
|
16
|
|
|
|
|
36
|
my $baseidx; |
2928
|
|
|
|
|
|
|
|
2929
|
|
|
|
|
|
|
# this was a conversion '$GLOBALS[x] -> $x' |
2930
|
|
|
|
|
|
|
# |
2931
|
16
|
100
|
|
|
|
95
|
unless ($basevar =~ /^(\#elem\d+)$/) { |
2932
|
1
|
50
|
|
|
|
5
|
$ctx->{log}->($ctx, 'resolve', $var, "%s[%s] -> global %s", $v, $i, $basevar) if $ctx->{log}; |
2933
|
1
|
|
|
|
|
4
|
return ($basevar, 0); |
2934
|
|
|
|
|
|
|
} |
2935
|
15
|
|
|
|
|
29
|
($basevar, $baseidx) = @{$parser->{strmap}->{$basevar}}; |
|
15
|
|
|
|
|
57
|
|
2936
|
|
|
|
|
|
|
|
2937
|
15
|
0
|
|
|
|
53
|
$ctx->{log}->($ctx, 'resolve', $var, "%s[%s] -> %s[%s]", $v, defined $i ? $i : '-', defined $basevar ? $basevar : '-', defined $baseidx ? $baseidx : '-') if $ctx->{log}; |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
2938
|
|
|
|
|
|
|
|
2939
|
15
|
50
|
|
|
|
41
|
if (defined $basevar) { |
2940
|
15
|
50
|
|
|
|
33
|
if (defined $i) { |
2941
|
15
|
|
|
|
|
40
|
my $idxstr = $ctx->exec_statement($i); |
2942
|
15
|
|
|
|
|
102
|
return ($basevar, 1, $idxstr); |
2943
|
|
|
|
|
|
|
} |
2944
|
|
|
|
|
|
|
} |
2945
|
|
|
|
|
|
|
} elsif ($var =~ /^#expr\d+$/) { |
2946
|
40
|
|
|
|
|
113
|
my $val = $ctx->resolve_varvar($var, $in_block); |
2947
|
40
|
100
|
66
|
|
|
145
|
if (($val ne $var) && !($val =~ /^#expr\d+$/)) { |
2948
|
27
|
|
|
|
|
82
|
return $ctx->resolve_variable($val, $in_block); |
2949
|
|
|
|
|
|
|
} |
2950
|
|
|
|
|
|
|
} |
2951
|
13
|
|
|
|
|
27
|
return; |
2952
|
|
|
|
|
|
|
} |
2953
|
|
|
|
|
|
|
|
2954
|
|
|
|
|
|
|
# resolves variables for function call argument list |
2955
|
|
|
|
|
|
|
# - an optional $prototype-list can be passed to check arguments |
2956
|
|
|
|
|
|
|
# |
2957
|
|
|
|
|
|
|
sub resolve_arglist { |
2958
|
768
|
|
|
768
|
0
|
1492
|
my ($ctx, $arglist, $param, $in_block) = @_; |
2959
|
768
|
|
|
|
|
1149
|
my @args = (); |
2960
|
768
|
|
|
|
|
1213
|
my $arg_changed = 0; |
2961
|
768
|
|
|
|
|
1035
|
my $i = 0; |
2962
|
|
|
|
|
|
|
|
2963
|
768
|
|
|
|
|
1463
|
foreach my $p (@$arglist) { |
2964
|
626
|
100
|
100
|
|
|
2612
|
if (($i < scalar @$param) && ($param->[$i++] =~ /^#ref\d+$/)) { |
|
|
100
|
66
|
|
|
|
|
2965
|
|
|
|
|
|
|
# reference is resolved in exec_func->set_func_params |
2966
|
|
|
|
|
|
|
# |
2967
|
27
|
|
|
|
|
82
|
push(@args, $p); |
2968
|
|
|
|
|
|
|
} elsif (!is_strval($p) || is_const($p)) { |
2969
|
255
|
|
|
|
|
727
|
my $v = $ctx->exec_statement($p, $in_block); |
2970
|
|
|
|
|
|
|
|
2971
|
255
|
|
|
|
|
587
|
push(@args, $v); |
2972
|
255
|
100
|
|
|
|
652
|
if ($v ne $p) { |
2973
|
158
|
|
|
|
|
352
|
$arg_changed = 1; |
2974
|
|
|
|
|
|
|
} |
2975
|
|
|
|
|
|
|
} else { |
2976
|
344
|
|
|
|
|
982
|
push(@args, $p); |
2977
|
|
|
|
|
|
|
} |
2978
|
|
|
|
|
|
|
} |
2979
|
768
|
|
|
|
|
2187
|
return (\@args, $arg_changed); |
2980
|
|
|
|
|
|
|
} |
2981
|
|
|
|
|
|
|
|
2982
|
|
|
|
|
|
|
sub invalidate_arglist_refs { |
2983
|
2
|
|
|
2
|
0
|
5
|
my ($ctx, $arglist, $param, $in_block) = @_; |
2984
|
2
|
|
|
|
|
4
|
my $i = 0; |
2985
|
|
|
|
|
|
|
|
2986
|
2
|
|
|
|
|
5
|
foreach my $p (@$arglist) { |
2987
|
4
|
100
|
66
|
|
|
23
|
if (($i < scalar @$param) && ($param->[$i++] =~ /^#ref\d+$/)) { |
2988
|
2
|
50
|
|
|
|
9
|
if (is_variable($p)) { |
2989
|
2
|
|
|
|
|
16
|
$ctx->setvar($p, '#unresolved', $in_block); |
2990
|
|
|
|
|
|
|
} |
2991
|
|
|
|
|
|
|
# todo: elem |
2992
|
|
|
|
|
|
|
} |
2993
|
|
|
|
|
|
|
} |
2994
|
2
|
|
|
|
|
4
|
return; |
2995
|
|
|
|
|
|
|
} |
2996
|
|
|
|
|
|
|
|
2997
|
|
|
|
|
|
|
sub loop_start { |
2998
|
59
|
|
|
59
|
0
|
119
|
my ($parser) = @_; |
2999
|
|
|
|
|
|
|
|
3000
|
59
|
50
|
|
|
|
143
|
unless (exists $parser->{strmap}->{_LOOP}) { |
3001
|
59
|
|
|
|
|
148
|
$parser->{strmap}->{_LOOP} = 0; |
3002
|
59
|
|
|
|
|
142
|
$parser->{strmap}->{_LOOP_LEVEL} = 1; |
3003
|
59
|
|
|
|
|
124
|
return 1; |
3004
|
|
|
|
|
|
|
} else { |
3005
|
0
|
|
|
|
|
0
|
$parser->{strmap}->{_LOOP_LEVEL}++; |
3006
|
|
|
|
|
|
|
} |
3007
|
0
|
|
|
|
|
0
|
return 0; |
3008
|
|
|
|
|
|
|
} |
3009
|
|
|
|
|
|
|
|
3010
|
|
|
|
|
|
|
sub loop_val { |
3011
|
0
|
|
|
0
|
0
|
0
|
my ($parser, $i) = @_; |
3012
|
0
|
|
|
|
|
0
|
return $i + $parser->{strmap}->{_LOOP}; |
3013
|
|
|
|
|
|
|
} |
3014
|
|
|
|
|
|
|
|
3015
|
|
|
|
|
|
|
sub loop_level { |
3016
|
42
|
|
|
42
|
0
|
71
|
my ($parser) = @_; |
3017
|
42
|
|
|
|
|
144
|
return $parser->{strmap}->{_LOOP_LEVEL}; |
3018
|
|
|
|
|
|
|
} |
3019
|
|
|
|
|
|
|
|
3020
|
|
|
|
|
|
|
sub loop_end { |
3021
|
59
|
|
|
59
|
0
|
124
|
my ($parser, $toploop, $i) = @_; |
3022
|
|
|
|
|
|
|
|
3023
|
59
|
50
|
|
|
|
141
|
if ($toploop) { |
3024
|
59
|
|
|
|
|
137
|
delete $parser->{strmap}->{_LOOP}; |
3025
|
59
|
|
|
|
|
103
|
delete $parser->{strmap}->{_LOOP_LEVEL}; |
3026
|
|
|
|
|
|
|
} else { |
3027
|
0
|
|
|
|
|
0
|
$parser->{strmap}->{_LOOP} += $i; |
3028
|
0
|
|
|
|
|
0
|
$parser->{strmap}->{_LOOP_LEVEL}--; |
3029
|
|
|
|
|
|
|
} |
3030
|
59
|
|
|
|
|
92
|
return; |
3031
|
|
|
|
|
|
|
} |
3032
|
|
|
|
|
|
|
|
3033
|
|
|
|
|
|
|
sub exec_statement { |
3034
|
8049
|
|
|
8049
|
1
|
15156
|
my ($ctx, $var, $in_block) = @_; |
3035
|
8049
|
|
|
|
|
12981
|
my $parser = $ctx->{parser}; |
3036
|
|
|
|
|
|
|
|
3037
|
8049
|
50
|
|
|
|
15380
|
if (!defined $var) { |
3038
|
0
|
|
|
|
|
0
|
$ctx->{warn}->($ctx, 'exec', '', ""); |
3039
|
0
|
|
|
|
|
0
|
return $var; |
3040
|
|
|
|
|
|
|
} |
3041
|
8049
|
100
|
100
|
|
|
16524
|
if (is_strval($var) && !is_const($var)) { |
3042
|
1096
|
|
|
|
|
3003
|
return $var; |
3043
|
|
|
|
|
|
|
} |
3044
|
6953
|
100
|
|
|
|
14494
|
if ($var =~ /^#ref\d+$/) { |
3045
|
6
|
|
|
|
|
17
|
return $var; |
3046
|
|
|
|
|
|
|
} |
3047
|
6947
|
0
|
|
|
|
13253
|
$ctx->{log}->($ctx, 'exec', $var, "%s%s", $parser->stmt_str($var), $in_block ? ' (inblock)' : '') if $ctx->{log}; |
|
|
50
|
|
|
|
|
|
3048
|
|
|
|
|
|
|
|
3049
|
6947
|
100
|
|
|
|
14585
|
if (is_variable($var)) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
3050
|
1588
|
100
|
|
|
|
4267
|
if (exists $ctx->{varmap}{ref}{$var}) { |
3051
|
15
|
|
|
|
|
54
|
my ($ctx2, $var1) = @{$ctx->{varmap}{ref}{$var}}; |
|
15
|
|
|
|
|
39
|
|
3052
|
|
|
|
|
|
|
#if (!$ctx->is_superglobal($var1) || ($var1 =~ /^\$GLOBALS$/)) { |
3053
|
15
|
50
|
|
|
|
39
|
$ctx->{log}->($ctx, 'exec', $var, "resolve reference -> $var1") if $ctx->{log}; |
3054
|
15
|
|
|
|
|
27
|
$var = $var1; |
3055
|
15
|
|
|
|
|
33
|
$ctx = $ctx2; |
3056
|
|
|
|
|
|
|
#} |
3057
|
|
|
|
|
|
|
} |
3058
|
1588
|
|
|
|
|
3766
|
my $val = $ctx->getvar($var); |
3059
|
1588
|
100
|
100
|
|
|
5892
|
if (defined $val && ($val eq '#unresolved')) { |
3060
|
266
|
50
|
|
|
|
627
|
$ctx->{log}->($ctx, 'exec', $var, "is unresolved") if $ctx->{log}; |
3061
|
266
|
|
|
|
|
468
|
$val = undef; |
3062
|
|
|
|
|
|
|
} |
3063
|
|
|
|
|
|
|
#if (defined $val && is_variable($val)) { |
3064
|
|
|
|
|
|
|
# my $vval = $ctx->exec_statement($val); |
3065
|
|
|
|
|
|
|
# $ctx->{log}->($ctx, 'exec', $var, "val $val vval $vval") if $ctx->{log}; |
3066
|
|
|
|
|
|
|
# if ($ctx->is_unresolved_assignment($vval)) { |
3067
|
|
|
|
|
|
|
# $val = undef; |
3068
|
|
|
|
|
|
|
# } |
3069
|
|
|
|
|
|
|
#} |
3070
|
1588
|
100
|
|
|
|
3295
|
if (defined $val) { |
3071
|
|
|
|
|
|
|
#unless ($val =~ /^\$GLOBALS$/) { |
3072
|
1031
|
|
|
|
|
1776
|
my $str = $val; |
3073
|
1031
|
100
|
|
|
|
2234
|
if (is_strval($val)) { |
|
|
100
|
|
|
|
|
|
3074
|
670
|
|
|
|
|
1382
|
$str = $parser->{strmap}{$val}; |
3075
|
670
|
50
|
|
|
|
1553
|
$ctx->{log}->($ctx, 'getvar', $var, "-> %s [%s]", $val, $parser->shortstr($str, 60)) if $ctx->{log}; |
3076
|
|
|
|
|
|
|
} elsif (is_array($val)) { |
3077
|
309
|
|
|
|
|
697
|
my $arr = $parser->{strmap}{$val}; |
3078
|
309
|
|
|
|
|
975
|
my $keys = $arr->get_keys(); |
3079
|
309
|
50
|
|
|
|
1052
|
$ctx->{log}->($ctx, 'getvar', $var, "-> %s [size: %d]", $val, scalar @$keys) if $ctx->{log}; |
3080
|
|
|
|
|
|
|
} else { |
3081
|
52
|
50
|
|
|
|
147
|
$ctx->{log}->($ctx, 'getvar', $var, "-> %s", $val) if $ctx->{log}; |
3082
|
|
|
|
|
|
|
} |
3083
|
1031
|
|
|
|
|
2612
|
return $val; |
3084
|
|
|
|
|
|
|
#} else { |
3085
|
|
|
|
|
|
|
# $ctx->{log}->($ctx, 'exec', $var, "is superglobal") if $ctx->{log}; |
3086
|
|
|
|
|
|
|
#} |
3087
|
|
|
|
|
|
|
} |
3088
|
557
|
|
|
|
|
1674
|
return $var; |
3089
|
|
|
|
|
|
|
} elsif (is_const($var)) { |
3090
|
89
|
|
|
|
|
259
|
my $v = $parser->{strmap}->{$var}; |
3091
|
|
|
|
|
|
|
|
3092
|
|
|
|
|
|
|
# constant (undefined constants propagate to string) |
3093
|
|
|
|
|
|
|
# constants are always global |
3094
|
|
|
|
|
|
|
# |
3095
|
|
|
|
|
|
|
# - some constants are magic (__LINE__ is handled in parser): |
3096
|
|
|
|
|
|
|
# https://www.php.net/manual/en/language.constants.magic.php |
3097
|
|
|
|
|
|
|
# |
3098
|
89
|
|
|
|
|
211
|
my $nv = $ctx->add_namespace($v); |
3099
|
|
|
|
|
|
|
|
3100
|
89
|
100
|
33
|
|
|
743
|
if (exists $ctx->{defines}{$nv}) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
3101
|
3
|
|
|
|
|
18
|
my $val = $ctx->{defines}{$nv}; |
3102
|
3
|
|
|
|
|
10
|
my $str = $val; |
3103
|
3
|
50
|
|
|
|
10
|
$ctx->{log}->($ctx, 'getdef', $var, "%s -> %s [%s]", $nv, $val, $parser->shortstr($str, 60)) if $ctx->{log}; |
3104
|
3
|
|
|
|
|
9
|
return $val; |
3105
|
|
|
|
|
|
|
} elsif ($v =~ /^__FUNCTION__$/) { |
3106
|
5
|
50
|
|
|
|
24
|
if ($ctx->{infunction}) { |
3107
|
5
|
|
|
|
|
20
|
my ($class, $prop) = method_split($ctx->{infunction}); |
3108
|
5
|
100
|
|
|
|
24
|
$prop = $ctx->{infunction} unless defined $prop; |
3109
|
5
|
|
|
|
|
17
|
my $fun = $ctx->getfun($prop); |
3110
|
5
|
100
|
|
|
|
41
|
if (defined $fun) { # convert name to mixedcase |
3111
|
4
|
|
|
|
|
11
|
my ($f, $a, $b, $p) = @{$parser->{strmap}->{$fun}}; |
|
4
|
|
|
|
|
21
|
|
3112
|
4
|
100
|
|
|
|
14
|
if ($ctx->{namespace}) { |
3113
|
1
|
|
|
|
|
7
|
$f = ns_name($ctx->{namespace}, $f); # keep namespace case here |
3114
|
|
|
|
|
|
|
} |
3115
|
4
|
|
|
|
|
12
|
return $parser->setstr($f); |
3116
|
|
|
|
|
|
|
} |
3117
|
|
|
|
|
|
|
} else { |
3118
|
0
|
|
|
|
|
0
|
return $parser->setstr(''); |
3119
|
|
|
|
|
|
|
} |
3120
|
|
|
|
|
|
|
} elsif ($v =~ /^__CLASS__$/) { |
3121
|
1
|
50
|
|
|
|
9
|
if (exists $ctx->{class_scope}) { |
3122
|
1
|
|
|
|
|
6
|
my $class = $ctx->getclass($ctx->{class_scope}); |
3123
|
1
|
50
|
|
|
|
5
|
if (defined $class) { # convert name to mixedcase |
3124
|
1
|
|
|
|
|
3
|
my ($n, $b, $p) = @{$parser->{strmap}->{$class}}; |
|
1
|
|
|
|
|
3
|
|
3125
|
1
|
50
|
|
|
|
288
|
if ($ctx->{namespace}) { |
3126
|
0
|
|
|
|
|
0
|
$n = ns_name($ctx->{namespace}, $n); # keep namespace case here |
3127
|
|
|
|
|
|
|
} |
3128
|
1
|
|
|
|
|
12
|
return $parser->setstr($n); |
3129
|
|
|
|
|
|
|
} |
3130
|
|
|
|
|
|
|
} else { |
3131
|
0
|
|
|
|
|
0
|
return $parser->setstr(''); |
3132
|
|
|
|
|
|
|
} |
3133
|
|
|
|
|
|
|
} elsif ($v =~ /^__METHOD__$/) { |
3134
|
4
|
50
|
|
|
|
13
|
if ($ctx->{infunction}) { |
3135
|
|
|
|
|
|
|
# internal method representation matches php class::name |
3136
|
4
|
|
|
|
|
12
|
my $fun = $ctx->getfun($ctx->{infunction}); |
3137
|
4
|
50
|
|
|
|
14
|
if (defined $fun) { |
3138
|
4
|
|
|
|
|
8
|
my ($f, $a, $b, $p) = @{$parser->{strmap}->{$fun}}; |
|
4
|
|
|
|
|
13
|
|
3139
|
4
|
|
|
|
|
16
|
my ($classname, $prop) = method_split($ctx->{infunction}); |
3140
|
4
|
|
|
|
|
6
|
my $name; # convert name to mixedcase |
3141
|
4
|
50
|
|
|
|
12
|
if (defined $classname) { |
3142
|
4
|
|
|
|
|
11
|
my $class = $ctx->getclass($classname); |
3143
|
4
|
|
|
|
|
7
|
my ($n, $cb, $cp) = @{$parser->{strmap}->{$class}}; |
|
4
|
|
|
|
|
22
|
|
3144
|
4
|
|
|
|
|
15
|
$name = method_name($n, $f); |
3145
|
|
|
|
|
|
|
} else { |
3146
|
0
|
|
|
|
|
0
|
$name = $f; |
3147
|
|
|
|
|
|
|
} |
3148
|
4
|
50
|
|
|
|
15
|
if ($ctx->{namespace}) { |
3149
|
0
|
|
|
|
|
0
|
$name = ns_name($ctx->{namespace}, $name); # keep namespace case here |
3150
|
|
|
|
|
|
|
} |
3151
|
4
|
|
|
|
|
15
|
return $parser->setstr($name); |
3152
|
|
|
|
|
|
|
} |
3153
|
|
|
|
|
|
|
} else { |
3154
|
0
|
|
|
|
|
0
|
return $parser->setstr(''); |
3155
|
|
|
|
|
|
|
} |
3156
|
|
|
|
|
|
|
} elsif ($v =~ /^__NAMESPACE__$/) { |
3157
|
1
|
50
|
|
|
|
5
|
if ($ctx->{namespace}) { |
3158
|
1
|
|
|
|
|
5
|
return $parser->setstr($ctx->{namespace}); |
3159
|
|
|
|
|
|
|
} else { |
3160
|
0
|
|
|
|
|
0
|
return $parser->setstr(''); |
3161
|
|
|
|
|
|
|
} |
3162
|
|
|
|
|
|
|
} elsif ($v =~ /^__DIR__$/) { |
3163
|
|
|
|
|
|
|
# skip |
3164
|
|
|
|
|
|
|
} elsif ($v =~ /^DIRECTORY_SEPARATOR$/) { |
3165
|
0
|
|
|
|
|
0
|
return $parser->setstr('/'); |
3166
|
|
|
|
|
|
|
} elsif ($v =~ /^PATH_SEPARATOR$/) { |
3167
|
0
|
|
|
|
|
0
|
return $parser->setstr('/'); |
3168
|
|
|
|
|
|
|
} elsif (exists $ctx->{globals} && exists $ctx->{globals}{$v}) { |
3169
|
0
|
|
|
|
|
0
|
my $val = $ctx->{globals}{$v}; |
3170
|
0
|
|
|
|
|
0
|
my $str = $val; |
3171
|
0
|
0
|
|
|
|
0
|
if (is_strval($val)) { |
3172
|
0
|
|
|
|
|
0
|
$str = $parser->{strmap}->{$val}; |
3173
|
|
|
|
|
|
|
} |
3174
|
0
|
0
|
|
|
|
0
|
$ctx->{log}->($ctx, 'getconst', $var, "%s -> %s [%s]", $v, $val, $parser->shortstr($str, 60)) if $ctx->{log}; |
3175
|
0
|
|
|
|
|
0
|
return $val; |
3176
|
|
|
|
|
|
|
} else { |
3177
|
74
|
100
|
|
|
|
151
|
unless ($ctx->{tainted}) { |
3178
|
50
|
|
|
|
|
152
|
my $k = $parser->setstr($v); |
3179
|
50
|
|
|
|
|
254
|
$ctx->{warn}->($ctx, 'exec', $var, "convert undefined const to string: $v -> $k"); |
3180
|
50
|
|
|
|
|
5020
|
return $k; |
3181
|
|
|
|
|
|
|
} else { |
3182
|
24
|
|
|
|
|
123
|
$ctx->{warn}->($ctx, 'exec', $var, "don't convert undefined const to string: $v -> tainted"); |
3183
|
|
|
|
|
|
|
} |
3184
|
|
|
|
|
|
|
} |
3185
|
26
|
|
|
|
|
1639
|
return $var; |
3186
|
|
|
|
|
|
|
} elsif ($var =~ /^#arr\d+$/) { |
3187
|
201
|
|
|
|
|
503
|
my $arr = $parser->{strmap}{$var}; |
3188
|
|
|
|
|
|
|
|
3189
|
|
|
|
|
|
|
# try to simplify array here (if not in function) |
3190
|
|
|
|
|
|
|
# |
3191
|
201
|
100
|
|
|
|
526
|
unless ($ctx->{incall}) { |
3192
|
145
|
50
|
|
|
|
353
|
if (exists $ctx->{simplify}{arr}) { |
3193
|
145
|
|
|
|
|
308
|
my @newkeys; |
3194
|
|
|
|
|
|
|
my %newmap; |
3195
|
145
|
|
|
|
|
200
|
my $changed = 0; |
3196
|
145
|
|
|
|
|
458
|
my $keys = $arr->get_keys(); |
3197
|
|
|
|
|
|
|
|
3198
|
145
|
|
|
|
|
355
|
foreach my $k (@$keys) { |
3199
|
205
|
|
|
|
|
487
|
my $val = $arr->val($k); |
3200
|
205
|
100
|
100
|
|
|
745
|
if ((is_int_index($k) || is_strval($k)) && (!defined $val |
|
|
|
66
|
|
|
|
|
|
|
|
100
|
|
|
|
|
3201
|
|
|
|
|
|
|
|| (defined $val && is_strval($val)))) { |
3202
|
191
|
|
|
|
|
401
|
push(@newkeys, $k); |
3203
|
191
|
|
|
|
|
542
|
$newmap{$k} = $val; |
3204
|
|
|
|
|
|
|
} else { |
3205
|
14
|
|
|
|
|
44
|
my $k2 = $k; |
3206
|
14
|
100
|
|
|
|
64
|
unless (is_int_index($k)) { |
3207
|
9
|
|
|
|
|
30
|
$k2 = $ctx->exec_statement($k); |
3208
|
|
|
|
|
|
|
} |
3209
|
14
|
|
|
|
|
61
|
push(@newkeys, $k2); |
3210
|
14
|
50
|
|
|
|
39
|
if (defined $val) { |
3211
|
14
|
|
|
|
|
38
|
my $v = $ctx->exec_statement($val); |
3212
|
14
|
|
|
|
|
62
|
$newmap{$k2} = $v; |
3213
|
|
|
|
|
|
|
} else { |
3214
|
0
|
|
|
|
|
0
|
$newmap{$k2} = undef; |
3215
|
|
|
|
|
|
|
} |
3216
|
14
|
100
|
100
|
|
|
95
|
if (($k ne $k2) || ($val ne $newmap{$k2})) { |
3217
|
10
|
|
|
|
|
29
|
$changed = 1; |
3218
|
|
|
|
|
|
|
} |
3219
|
|
|
|
|
|
|
} |
3220
|
|
|
|
|
|
|
} |
3221
|
145
|
100
|
|
|
|
492
|
if ($changed) { |
3222
|
10
|
|
|
|
|
32
|
$arr = $parser->newarr(); |
3223
|
10
|
|
|
|
|
37
|
foreach my $k (@newkeys) { |
3224
|
12
|
|
|
|
|
40
|
$arr->set($k, $newmap{$k}); |
3225
|
|
|
|
|
|
|
} |
3226
|
10
|
50
|
|
|
|
67
|
$ctx->{log}->($ctx, 'exec', $var, "simplify -> $arr->{name}") if $ctx->{log}; |
3227
|
10
|
|
|
|
|
49
|
return $arr->{name}; |
3228
|
|
|
|
|
|
|
} |
3229
|
|
|
|
|
|
|
} |
3230
|
|
|
|
|
|
|
} |
3231
|
191
|
|
|
|
|
508
|
return $var; |
3232
|
|
|
|
|
|
|
} elsif ($var =~ /^#obj\d+$/) { |
3233
|
22
|
|
|
|
|
60
|
my ($o, $m) = @{$parser->{strmap}->{$var}}; |
|
22
|
|
|
|
|
125
|
|
3234
|
|
|
|
|
|
|
|
3235
|
22
|
|
|
|
|
92
|
my ($inst, $prop) = $ctx->resolve_obj($var, $in_block); |
3236
|
22
|
100
|
|
|
|
66
|
if (defined $inst) { |
3237
|
13
|
|
|
|
|
70
|
my $instvar = inst_var($inst, '$'.$prop); |
3238
|
|
|
|
|
|
|
|
3239
|
13
|
|
|
|
|
35
|
my $basestr = $ctx->getvar($instvar); |
3240
|
13
|
100
|
100
|
|
|
59
|
if (defined $basestr && ($basestr ne '#unresolved')) { |
3241
|
11
|
|
|
|
|
36
|
return $basestr; |
3242
|
|
|
|
|
|
|
} |
3243
|
2
|
50
|
|
|
|
21
|
if ($m ne $prop) { |
3244
|
0
|
|
|
|
|
0
|
my $k = $parser->setobj($o, $prop); |
3245
|
0
|
0
|
|
|
|
0
|
$ctx->{log}->($ctx, 'exec', $var, "simplify partial -> $k") if $ctx->{log}; |
3246
|
0
|
|
|
|
|
0
|
return $k; |
3247
|
|
|
|
|
|
|
} |
3248
|
|
|
|
|
|
|
} |
3249
|
11
|
|
|
|
|
30
|
return $var; |
3250
|
|
|
|
|
|
|
} elsif ($var =~ /^#scope\d+$/) { |
3251
|
16
|
|
|
|
|
27
|
my ($c, $e) = @{$parser->{strmap}->{$var}}; |
|
16
|
|
|
|
|
77
|
|
3252
|
|
|
|
|
|
|
|
3253
|
16
|
|
|
|
|
46
|
my ($scope, $val) = $ctx->resolve_scope($var, $in_block); |
3254
|
16
|
50
|
|
|
|
46
|
if (defined $scope) { |
3255
|
16
|
100
|
|
|
|
38
|
if (is_variable($val)) { |
|
|
50
|
|
|
|
|
|
3256
|
13
|
|
|
|
|
43
|
my $classvar = inst_var($scope, $val); |
3257
|
|
|
|
|
|
|
|
3258
|
13
|
|
|
|
|
38
|
my $basestr = $ctx->getvar($classvar); |
3259
|
13
|
100
|
100
|
|
|
58
|
if (defined $basestr && ($basestr ne '#unresolved')) { |
3260
|
2
|
|
|
|
|
7
|
return $basestr; |
3261
|
|
|
|
|
|
|
} |
3262
|
11
|
|
|
|
|
36
|
return $classvar; |
3263
|
|
|
|
|
|
|
} elsif (is_symbol($val)) { |
3264
|
3
|
|
|
|
|
9
|
my $name = method_name($scope, $val); |
3265
|
|
|
|
|
|
|
|
3266
|
3
|
50
|
|
|
|
12
|
if (exists $ctx->{defines}{$name}) { |
3267
|
3
|
|
|
|
|
7
|
my $const = $ctx->{defines}{$name}; |
3268
|
3
|
50
|
|
|
|
10
|
$ctx->{log}->($ctx, 'exec', $var, "lookup const %s -> %s", $name, $const) if $ctx->{log}; |
3269
|
3
|
|
|
|
|
8
|
return $const; |
3270
|
|
|
|
|
|
|
} |
3271
|
0
|
|
|
|
|
0
|
return $name; |
3272
|
|
|
|
|
|
|
} |
3273
|
0
|
0
|
|
|
|
0
|
if ($c ne $scope) { |
3274
|
0
|
0
|
0
|
|
|
0
|
if ($ctx->{incall} && ($c =~ /^(self|parent)$/)) { |
3275
|
0
|
|
|
|
|
0
|
$ctx->{warn}->($ctx, 'exec', $var, "simplify $c -> $scope in function"); |
3276
|
|
|
|
|
|
|
} |
3277
|
|
|
|
|
|
|
# only simplified call, no result |
3278
|
0
|
|
|
|
|
0
|
my $k = $parser->setscope($scope, $e); |
3279
|
0
|
0
|
|
|
|
0
|
$ctx->{log}->($ctx, 'exec', $var, "simplify partial -> $k") if $ctx->{log}; |
3280
|
0
|
|
|
|
|
0
|
return $k; |
3281
|
|
|
|
|
|
|
} |
3282
|
|
|
|
|
|
|
} |
3283
|
0
|
|
|
|
|
0
|
return $var; |
3284
|
|
|
|
|
|
|
} elsif ($var =~ /^#ns\d+$/) { |
3285
|
9
|
|
|
|
|
20
|
my ($n, $e) = @{$parser->{strmap}->{$var}}; |
|
9
|
|
|
|
|
35
|
|
3286
|
|
|
|
|
|
|
|
3287
|
9
|
|
|
|
|
33
|
my ($ns, $val) = $ctx->resolve_ns($var, $in_block); |
3288
|
9
|
50
|
|
|
|
20
|
if (defined $ns) { |
3289
|
9
|
50
|
|
|
|
40
|
if ($val =~ /^#class\d+$/) { |
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
3290
|
|
|
|
|
|
|
} elsif ($val =~ /^#fun\d+$/) { |
3291
|
|
|
|
|
|
|
} elsif (is_const($val)) { |
3292
|
4
|
|
|
|
|
14
|
my $str = $parser->get_strval($val); |
3293
|
4
|
|
|
|
|
27
|
my $name = ns_name(lc($ns), $str); |
3294
|
4
|
|
|
|
|
17
|
my ($sym) = $name =~ /^\\(.*)$/; # remove toplevel |
3295
|
|
|
|
|
|
|
|
3296
|
4
|
50
|
33
|
|
|
21
|
if (defined $sym && exists $ctx->{defines}{$sym}) { |
3297
|
4
|
|
|
|
|
12
|
my $const = $ctx->{defines}{$sym}; |
3298
|
4
|
50
|
|
|
|
12
|
$ctx->{log}->($ctx, 'exec', $var, "lookup const %s -> %s", $name, $const) if $ctx->{log}; |
3299
|
4
|
|
|
|
|
13
|
return $const; |
3300
|
|
|
|
|
|
|
} |
3301
|
0
|
|
|
|
|
0
|
return $name; |
3302
|
|
|
|
|
|
|
} elsif (is_strval($val)) { |
3303
|
0
|
|
|
|
|
0
|
my $str = $parser->get_strval($val); |
3304
|
0
|
|
|
|
|
0
|
my $name = ns_name(lc($ns), $str); |
3305
|
0
|
|
|
|
|
0
|
return $name; |
3306
|
|
|
|
|
|
|
} elsif (is_symbol($val)) { |
3307
|
5
|
|
|
|
|
52
|
my $name = ns_name(lc($ns), $val); |
3308
|
5
|
|
|
|
|
18
|
my ($sym) = $name =~ /^\/(.*)$/; |
3309
|
5
|
|
|
|
|
16
|
return $name; |
3310
|
|
|
|
|
|
|
} |
3311
|
|
|
|
|
|
|
} |
3312
|
0
|
|
|
|
|
0
|
return $var; |
3313
|
|
|
|
|
|
|
} elsif ($var =~ /^#elem\d+$/) { |
3314
|
363
|
|
|
|
|
662
|
my ($v, $i) = @{$parser->{strmap}->{$var}}; |
|
363
|
|
|
|
|
1240
|
|
3315
|
363
|
|
|
|
|
672
|
my $basevar = $v; |
3316
|
363
|
|
|
|
|
1679
|
my $basestr = $ctx->exec_statement($v, $in_block); |
3317
|
363
|
|
|
|
|
747
|
my $idxstr = $i; |
3318
|
|
|
|
|
|
|
|
3319
|
363
|
100
|
|
|
|
995
|
if (is_null($basestr)) { |
3320
|
18
|
|
|
|
|
39
|
$basestr = undef; |
3321
|
|
|
|
|
|
|
} |
3322
|
363
|
50
|
|
|
|
788
|
if (defined $i) { |
3323
|
363
|
100
|
100
|
|
|
772
|
if (!is_strval($i) || is_const($i)) { |
3324
|
163
|
|
|
|
|
428
|
$idxstr = $ctx->exec_statement($i); |
3325
|
|
|
|
|
|
|
} |
3326
|
363
|
100
|
|
|
|
923
|
if (defined $basestr) { |
3327
|
345
|
|
|
|
|
1024
|
my $g = $parser->globalvar_to_var($basestr, $idxstr); |
3328
|
345
|
100
|
|
|
|
902
|
if (defined $g) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
3329
|
63
|
100
|
|
|
|
188
|
if ($ctx->{infunction}) { |
3330
|
24
|
|
|
|
|
69
|
$g = global_var($g); |
3331
|
|
|
|
|
|
|
} |
3332
|
63
|
|
|
|
|
173
|
$basestr = $ctx->getvar($g); |
3333
|
|
|
|
|
|
|
|
3334
|
63
|
0
|
|
|
|
243
|
$ctx->{log}->($ctx, 'exec', $var, "getelem %s -> %s (%s)", $parser->stmt_str($var), $g, defined $basestr ? $basestr : '-') if $ctx->{log}; |
|
|
50
|
|
|
|
|
|
3335
|
|
|
|
|
|
|
|
3336
|
63
|
100
|
100
|
|
|
257
|
if (defined $basestr && ($basestr eq '#unresolved')) { |
3337
|
9
|
|
|
|
|
21
|
$basestr = undef; |
3338
|
|
|
|
|
|
|
} |
3339
|
63
|
100
|
|
|
|
166
|
if (defined $basestr) { |
3340
|
40
|
|
|
|
|
107
|
return $ctx->exec_statement($basestr); |
3341
|
|
|
|
|
|
|
} |
3342
|
23
|
|
|
|
|
100
|
return $g; # return simplified global var |
3343
|
|
|
|
|
|
|
} elsif ($ctx->is_superglobal($basestr)) { |
3344
|
51
|
|
|
|
|
147
|
$basevar = $basestr; |
3345
|
51
|
|
|
|
|
145
|
my $val = $ctx->getvar($basestr); |
3346
|
51
|
50
|
|
|
|
213
|
if (defined $val) { |
3347
|
0
|
|
|
|
|
0
|
$basestr = $val; |
3348
|
|
|
|
|
|
|
} |
3349
|
|
|
|
|
|
|
} elsif (is_variable($basestr)) { |
3350
|
19
|
100
|
|
|
|
83
|
if ($basestr eq $basevar) { # getvar() failed |
3351
|
9
|
|
|
|
|
26
|
$basestr = $ctx->getvar($basevar); |
3352
|
|
|
|
|
|
|
} else { |
3353
|
10
|
|
|
|
|
20
|
$basevar = $basestr; |
3354
|
|
|
|
|
|
|
} |
3355
|
|
|
|
|
|
|
} elsif ($basestr =~ /^#elem\d+$/) { |
3356
|
7
|
|
|
|
|
28
|
$basevar = $basestr; |
3357
|
|
|
|
|
|
|
} |
3358
|
|
|
|
|
|
|
} |
3359
|
|
|
|
|
|
|
} |
3360
|
300
|
0
|
|
|
|
758
|
$ctx->{log}->($ctx, 'exec', $var, "getelem %s -> %s[%s] (%s)", $parser->stmt_str($var), $basevar, defined $idxstr ? $idxstr : '-', defined $basestr ? $basestr : '-') if $ctx->{log}; |
|
|
0
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
3361
|
|
|
|
|
|
|
|
3362
|
300
|
100
|
100
|
|
|
1764
|
if (defined $basestr && ($basestr eq '#unresolved')) { |
|
|
100
|
100
|
|
|
|
|
|
|
100
|
66
|
|
|
|
|
|
|
100
|
66
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
|
66
|
|
|
|
|
3363
|
7
|
50
|
|
|
|
34
|
$ctx->{warn}->($ctx, 'exec', $var, "getelem %s[%s] is unresolved", $basevar, defined $i ? $i : ''); |
3364
|
|
|
|
|
|
|
} elsif (defined $basestr && is_strval($basestr) && !is_null($basestr) && defined $idxstr && is_strval($idxstr)) { # TODO: is_numeric() for undefined vars? |
3365
|
31
|
|
|
|
|
86
|
my $baseval = $parser->get_strval($basestr); |
3366
|
31
|
|
|
|
|
80
|
my $pos = $parser->get_strval($idxstr); |
3367
|
|
|
|
|
|
|
|
3368
|
|
|
|
|
|
|
# todo: $pos might be non-numeric array-key here |
3369
|
|
|
|
|
|
|
# |
3370
|
31
|
50
|
|
|
|
145
|
if ($pos =~ /^[\d\.]+$/) { |
3371
|
31
|
|
|
|
|
76
|
$pos = int($pos); |
3372
|
31
|
100
|
|
|
|
74
|
if ($pos >= length($baseval)) { |
3373
|
|
|
|
|
|
|
# array out of range maps to empty string |
3374
|
|
|
|
|
|
|
# todo: support string access via brackets: $str{4} |
3375
|
|
|
|
|
|
|
# |
3376
|
3
|
|
|
|
|
25
|
$ctx->{warn}->($ctx, 'exec', $var, "get array index out of range %d (%d): %s", $pos, length($baseval), $baseval); |
3377
|
|
|
|
|
|
|
# just allow off-by-one errors for now to avoid endless loops |
3378
|
|
|
|
|
|
|
# |
3379
|
3
|
50
|
|
|
|
294
|
if ($pos == length($baseval)) { |
3380
|
3
|
|
|
|
|
20
|
my $ch = ''; |
3381
|
3
|
|
|
|
|
14
|
return $parser->setstr($ch); |
3382
|
|
|
|
|
|
|
} |
3383
|
|
|
|
|
|
|
} else { |
3384
|
28
|
|
|
|
|
70
|
my $ch = substr($baseval, $pos, 1); |
3385
|
28
|
|
|
|
|
79
|
my $k = $parser->setstr($ch); |
3386
|
28
|
50
|
|
|
|
99
|
$ctx->{log}->($ctx, 'exec', $var, "getelem %s[%s] = %s", $basestr, $pos, $ch) if $ctx->{log}; |
3387
|
28
|
|
|
|
|
96
|
return $k; |
3388
|
|
|
|
|
|
|
} |
3389
|
|
|
|
|
|
|
} |
3390
|
|
|
|
|
|
|
} elsif (defined $basestr && is_array($basestr) && defined $idxstr) { |
3391
|
169
|
|
|
|
|
401
|
my $arr = $parser->{strmap}{$basestr}; |
3392
|
169
|
100
|
|
|
|
391
|
$idxstr = $parser->setstr('') if is_null($idxstr); # null maps to '' array index |
3393
|
169
|
|
|
|
|
533
|
my $arrval = $arr->get($idxstr); |
3394
|
169
|
100
|
|
|
|
746
|
if (defined $arrval) { |
3395
|
135
|
50
|
|
|
|
287
|
$ctx->{log}->($ctx, 'exec', $var, "getelem %s[%s] = %s[%s]", $basevar, $idxstr, $basestr, $arrval) if $ctx->{log}; |
3396
|
135
|
|
|
|
|
369
|
return $arrval; |
3397
|
|
|
|
|
|
|
} |
3398
|
|
|
|
|
|
|
} elsif (!(exists $ctx->{skip}{null}) && !defined $basestr && (!$ctx->is_superglobal($basevar) || ($basevar =~ /^\$GLOBALS$/))) { |
3399
|
20
|
100
|
|
|
|
68
|
unless ($ctx->{tainted}) { |
3400
|
18
|
50
|
|
|
|
111
|
$ctx->{warn}->($ctx, 'exec', $var, "getelem %s[%s] not found -> #null", $basevar, defined $i ? $i : ''); |
3401
|
18
|
|
|
|
|
2018
|
return '#null'; |
3402
|
|
|
|
|
|
|
} |
3403
|
|
|
|
|
|
|
} |
3404
|
|
|
|
|
|
|
# simplify elem expression |
3405
|
|
|
|
|
|
|
# (don't simplify $GLOBAL[..] references when parsing function) |
3406
|
|
|
|
|
|
|
# |
3407
|
116
|
50
|
|
|
|
831
|
if (exists $ctx->{simplify}{elem}) { |
3408
|
116
|
50
|
|
|
|
234
|
if (defined $i) { |
3409
|
116
|
100
|
100
|
|
|
476
|
if (($v ne $basevar) || ($i ne $idxstr)) { |
3410
|
36
|
|
|
|
|
117
|
my $k = $parser->setelem($basevar, $idxstr); |
3411
|
36
|
50
|
|
|
|
137
|
$ctx->{log}->($ctx, 'exec', $var, "simplify %s -> %s[%s]", $parser->stmt_str($var), $basevar, $idxstr) if $ctx->{log}; |
3412
|
36
|
|
|
|
|
126
|
return $k; |
3413
|
|
|
|
|
|
|
} |
3414
|
|
|
|
|
|
|
} |
3415
|
|
|
|
|
|
|
} |
3416
|
80
|
|
|
|
|
251
|
return $var; |
3417
|
|
|
|
|
|
|
} elsif ($var =~ /^#expr\d+$/) { |
3418
|
1618
|
|
|
|
|
2503
|
my ($op, $v1, $v2) = @{$parser->{strmap}->{$var}}; |
|
1618
|
|
|
|
|
4967
|
|
3419
|
1618
|
|
|
|
|
2721
|
my $op2; |
3420
|
|
|
|
|
|
|
|
3421
|
1618
|
100
|
66
|
|
|
4739
|
if (($op eq '=') && defined $v2) { |
3422
|
1030
|
|
|
|
|
1691
|
my $vv1 = $v1; |
3423
|
|
|
|
|
|
|
|
3424
|
1030
|
100
|
|
|
|
2035
|
if ($v1 =~ /^#obj\d+$/) { |
3425
|
11
|
|
|
|
|
53
|
my ($inst, $prop) = $ctx->resolve_obj($v1, $in_block); |
3426
|
11
|
100
|
|
|
|
32
|
if (defined $inst) { |
3427
|
7
|
|
|
|
|
58
|
my $instvar = inst_var($inst, '$'.$prop); |
3428
|
7
|
50
|
|
|
|
33
|
$ctx->{log}->($ctx, 'exec', $var, "assign to var $v1 -> resolved to instvar $instvar") if $ctx->{log}; |
3429
|
7
|
|
|
|
|
16
|
$vv1 = $instvar; |
3430
|
|
|
|
|
|
|
} |
3431
|
|
|
|
|
|
|
} |
3432
|
1030
|
100
|
|
|
|
1950
|
if ($v1 =~ /^#scope\d+$/) { |
3433
|
9
|
|
|
|
|
26
|
my ($scope, $val) = $ctx->resolve_scope($v1, $in_block); |
3434
|
9
|
50
|
33
|
|
|
34
|
if (defined $scope && is_variable($val)) { |
3435
|
9
|
|
|
|
|
29
|
my $classvar = inst_var($scope, $val); |
3436
|
9
|
50
|
|
|
|
28
|
$ctx->{log}->($ctx, 'exec', $var, "assign to var $v1 -> resolved to classvar $classvar") if $ctx->{log}; |
3437
|
9
|
|
|
|
|
16
|
$vv1 = $classvar; |
3438
|
|
|
|
|
|
|
} |
3439
|
|
|
|
|
|
|
} |
3440
|
1030
|
100
|
|
|
|
1886
|
if ($v1 =~ /^#expr\d+$/) { |
3441
|
|
|
|
|
|
|
# calc variable name (a.e: ${ $var }) |
3442
|
|
|
|
|
|
|
# |
3443
|
13
|
|
|
|
|
46
|
my $basevar = $ctx->resolve_varvar($v1, $in_block); |
3444
|
13
|
100
|
66
|
|
|
62
|
if (defined $basevar && ($basevar ne $v1)) { |
3445
|
10
|
50
|
|
|
|
39
|
$ctx->{log}->($ctx, 'exec', $var, "assign to var $v1 -> resolved to varvar $basevar") if $ctx->{log}; |
3446
|
10
|
|
|
|
|
18
|
$vv1 = $basevar; |
3447
|
|
|
|
|
|
|
} |
3448
|
|
|
|
|
|
|
} |
3449
|
|
|
|
|
|
|
# don't simplify #obj variable to $#inst\d+$var |
3450
|
|
|
|
|
|
|
# |
3451
|
1030
|
100
|
|
|
|
2286
|
my $vv1_sim = is_instvar($vv1) ? $v1 : $vv1; |
3452
|
|
|
|
|
|
|
|
3453
|
1030
|
50
|
|
|
|
1964
|
if (defined $v2) { |
3454
|
|
|
|
|
|
|
# always track variables here for statements like '$a = $b = 1' |
3455
|
|
|
|
|
|
|
# |
3456
|
1030
|
|
|
|
|
2674
|
$op2 = $ctx->exec_statement($v2); |
3457
|
|
|
|
|
|
|
} |
3458
|
1030
|
100
|
|
|
|
2344
|
if (is_variable($vv1)) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
3459
|
865
|
100
|
66
|
|
|
5575
|
if (defined $op2 && ($op2 =~ /^#ref\d+$/)) { |
|
|
100
|
66
|
|
|
|
|
|
|
100
|
66
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
3460
|
6
|
|
|
|
|
20
|
my $v = $parser->{strmap}->{$op2}->[0]; |
3461
|
|
|
|
|
|
|
|
3462
|
|
|
|
|
|
|
# reference operator sets variable alias |
3463
|
|
|
|
|
|
|
# (-> undo alias by unset($vv1) or by assignment of another reference) |
3464
|
|
|
|
|
|
|
# |
3465
|
6
|
|
|
|
|
25
|
$ctx->{varmap}{ref}{$vv1} = [$ctx, $v]; |
3466
|
6
|
50
|
|
|
|
21
|
$ctx->{log}->($ctx, 'setref', $vv1, "references $v now") if $ctx->{log}; |
3467
|
|
|
|
|
|
|
} elsif (defined $v2 && ($v2 =~ /^\$GLOBALS$/)) { |
3468
|
|
|
|
|
|
|
# $var = $GLOBALS assignment is always equal to reference (but not superglobals) |
3469
|
|
|
|
|
|
|
# https://php.net/manual/en/reserved.variables.globals.php |
3470
|
|
|
|
|
|
|
# |
3471
|
3
|
|
|
|
|
37
|
$ctx->{varmap}{ref}{$vv1} = [$ctx, $v2]; |
3472
|
3
|
50
|
|
|
|
22
|
$ctx->{log}->($ctx, 'setref', $vv1, "implicitly references GLOBALS now") if $ctx->{log}; |
3473
|
|
|
|
|
|
|
} elsif (defined $v2 && $ctx->is_superglobal($v2)) { |
3474
|
|
|
|
|
|
|
# other superglobal assignments work only on a copy of the array |
3475
|
|
|
|
|
|
|
# - returns 1: $_POST['a']=1; $x=$_POST; echo $x['a']; |
3476
|
|
|
|
|
|
|
# - returns null: $x=$_POST; $_POST['a']=1; echo $x['a']; |
3477
|
|
|
|
|
|
|
# - returns 1: $x=$_POST; $x['a']=1; echo $x['a']; |
3478
|
|
|
|
|
|
|
# - returns null: $x=$_POST; $x['a']=1; echo $_POST['a']; |
3479
|
|
|
|
|
|
|
# - returns null: $x["a"]="b"; $x=$_POST; echo $_POST["a"]; |
3480
|
|
|
|
|
|
|
# but normal reference work: |
3481
|
|
|
|
|
|
|
# - returns 1 $x=&$_POST; $x["a"]=1; echo $_POST["a"]; |
3482
|
|
|
|
|
|
|
# |
3483
|
|
|
|
|
|
|
# Note: The resulting code should track superglobal derefences, |
3484
|
|
|
|
|
|
|
# so handle them like $GLOBALS for now. |
3485
|
|
|
|
|
|
|
# |
3486
|
5
|
|
|
|
|
14
|
my $a = $ctx->getvar($v2); |
3487
|
5
|
100
|
66
|
|
|
39
|
if (defined $a && is_array($a)) { |
3488
|
1
|
|
|
|
|
6
|
my $arr = $parser->{strmap}{$a}; |
3489
|
1
|
|
|
|
|
6
|
$arr = $arr->copy(); |
3490
|
1
|
|
|
|
|
4
|
my $a2 = $arr->{name}; |
3491
|
1
|
50
|
|
|
|
5
|
$ctx->{log}->($ctx, 'setref', $vv1, "copy defined superglobal $v2 -> $a") if $ctx->{log}; |
3492
|
1
|
|
|
|
|
5
|
$ctx->setvar($vv1, $a2, $in_block); |
3493
|
1
|
|
|
|
|
5
|
return $parser->setexpr('=', $vv1_sim, $a2); |
3494
|
|
|
|
|
|
|
} else { |
3495
|
|
|
|
|
|
|
#$ctx->setvar($vv1, $v2, $in_block); |
3496
|
4
|
|
|
|
|
18
|
$ctx->setvar($vv1, '#unresolved', $in_block); |
3497
|
4
|
|
|
|
|
10
|
$op2 = $v2; |
3498
|
4
|
50
|
|
|
|
30
|
$ctx->{log}->($ctx, 'setref', $vv1, "keep undefined superglobal $v2") if $ctx->{log}; |
3499
|
|
|
|
|
|
|
} |
3500
|
|
|
|
|
|
|
} elsif ($ctx->is_unresolved_assignment($op2)) { |
3501
|
|
|
|
|
|
|
# mark variable as unresolved if rhs is not resolvable |
3502
|
|
|
|
|
|
|
# |
3503
|
133
|
|
|
|
|
435
|
$ctx->setvar($vv1, '#unresolved', $in_block); |
3504
|
133
|
100
|
66
|
|
|
499
|
if ($in_block || !exists $ctx->{varhist}) { |
3505
|
120
|
50
|
|
|
|
326
|
$ctx->{log}->($ctx, 'exec', $var, "assign to var $vv1 = $op2 -> #unresolved") if $ctx->{log}; |
3506
|
120
|
100
|
100
|
|
|
465
|
if (($v1 ne $vv1_sim) || ($v2 ne $op2)) { |
3507
|
25
|
|
|
|
|
107
|
return $parser->setexpr('=', $vv1_sim, $op2); |
3508
|
|
|
|
|
|
|
} |
3509
|
95
|
|
|
|
|
308
|
return $var; |
3510
|
|
|
|
|
|
|
} |
3511
|
13
|
50
|
|
|
|
41
|
$ctx->{log}->($ctx, 'exec', $var, "assign to var $vv1 = $op2 -> #unresolved [TRACK]") if $ctx->{log}; |
3512
|
13
|
|
|
|
|
48
|
$ctx->track_assignment($vv1, $op2); |
3513
|
13
|
|
|
|
|
63
|
return $vv1; |
3514
|
|
|
|
|
|
|
} elsif (is_block($op2)) { |
3515
|
|
|
|
|
|
|
# this might be a create_function() assignment returning a |
3516
|
|
|
|
|
|
|
# block with multiple elements. |
3517
|
|
|
|
|
|
|
# convert '$var = { #fun; #stmt }' to '{ $var = #fun; #stmt }' |
3518
|
|
|
|
|
|
|
# |
3519
|
1
|
|
|
|
|
4
|
my ($type, $a) = @{$parser->{strmap}->{$op2}}; |
|
1
|
|
|
|
|
7
|
|
3520
|
1
|
50
|
|
|
|
7
|
if (scalar @$a > 0) { |
3521
|
1
|
|
|
|
|
8
|
$ctx->setvar($vv1, $a->[0], $in_block); |
3522
|
1
|
|
|
|
|
6
|
my $k = $parser->setexpr('=', $vv1_sim, $a->[0]); |
3523
|
1
|
|
|
|
|
14
|
my $b = $parser->setblk('flat', [$k, @$a[1..@$a-1]]); |
3524
|
1
|
50
|
|
|
|
5
|
$ctx->{log}->($ctx, 'exec', $var, "assign to var $vv1 = $op2 -> converted to block $k") if $ctx->{log}; |
3525
|
1
|
|
|
|
|
7
|
return $b; |
3526
|
|
|
|
|
|
|
} else { |
3527
|
0
|
0
|
|
|
|
0
|
$ctx->{log}->($ctx, 'exec', $var, "assign to var %s = %s -> %s (block)", $vv1, $v2, $op2) if $ctx->{log}; |
3528
|
0
|
|
|
|
|
0
|
$ctx->setvar($vv1, $op2, $in_block); |
3529
|
|
|
|
|
|
|
} |
3530
|
|
|
|
|
|
|
} else { |
3531
|
717
|
50
|
|
|
|
1636
|
$ctx->{log}->($ctx, 'exec', $var, "assign to var %s = %s -> %s", $vv1, $v2, $op2) if $ctx->{log}; |
3532
|
717
|
|
|
|
|
1833
|
$ctx->setvar($vv1, $op2, $in_block); |
3533
|
|
|
|
|
|
|
} |
3534
|
730
|
100
|
|
|
|
1516
|
if ($in_block) { |
3535
|
669
|
100
|
100
|
|
|
2351
|
if (($v1 ne $vv1_sim) || ($v2 ne $op2)) { |
3536
|
218
|
|
|
|
|
672
|
return $parser->setexpr('=', $vv1_sim, $op2); |
3537
|
|
|
|
|
|
|
} |
3538
|
|
|
|
|
|
|
} else { |
3539
|
61
|
|
|
|
|
219
|
return $op2; |
3540
|
|
|
|
|
|
|
} |
3541
|
|
|
|
|
|
|
} elsif ($v1 =~ /^#elem\d+$/) { |
3542
|
148
|
|
|
|
|
268
|
my ($v, $i) = @{$parser->{strmap}->{$v1}}; |
|
148
|
|
|
|
|
485
|
|
3543
|
148
|
|
|
|
|
446
|
my $elemlist = $ctx->get_baseelem($v1, $in_block); |
3544
|
148
|
|
|
|
|
298
|
my $basevar = $elemlist->[0]; |
3545
|
148
|
|
|
|
|
690
|
my $basestr; |
3546
|
|
|
|
|
|
|
my $baseidx; |
3547
|
148
|
|
|
|
|
0
|
my $idxstr; |
3548
|
148
|
|
|
|
|
0
|
my $has_index; |
3549
|
148
|
|
|
|
|
0
|
my $parent; |
3550
|
|
|
|
|
|
|
|
3551
|
148
|
100
|
|
|
|
528
|
if ($basevar =~ /^(\#elem\d+)$/) { |
3552
|
123
|
|
|
|
|
194
|
($basevar, $baseidx) = @{$parser->{strmap}->{$basevar}}; |
|
123
|
|
|
|
|
363
|
|
3553
|
123
|
|
|
|
|
386
|
($parent, $basestr, $basevar) = $ctx->create_basearray($elemlist, $in_block); |
3554
|
123
|
|
|
|
|
237
|
$has_index = 1; |
3555
|
|
|
|
|
|
|
} else { |
3556
|
25
|
|
|
|
|
50
|
$has_index = 0; # conversion '$GLOBALS[x] -> $x' |
3557
|
25
|
|
|
|
|
45
|
$parent = $basevar; |
3558
|
25
|
|
|
|
|
66
|
$basestr = $ctx->exec_statement($basevar, $in_block); |
3559
|
|
|
|
|
|
|
} |
3560
|
|
|
|
|
|
|
|
3561
|
148
|
100
|
66
|
|
|
556
|
if (defined $basestr && is_null($basestr)) { |
3562
|
10
|
|
|
|
|
24
|
$basestr = undef; |
3563
|
|
|
|
|
|
|
} |
3564
|
148
|
50
|
66
|
|
|
582
|
if (defined $basestr && ($basestr eq '#unresolved')) { |
3565
|
0
|
|
|
|
|
0
|
$basestr = undef; |
3566
|
|
|
|
|
|
|
} |
3567
|
148
|
100
|
|
|
|
293
|
if (defined $i) { |
3568
|
123
|
|
|
|
|
303
|
$idxstr = $ctx->exec_statement($i); |
3569
|
|
|
|
|
|
|
} |
3570
|
|
|
|
|
|
|
|
3571
|
148
|
50
|
|
|
|
475
|
if (defined $basevar) { |
3572
|
148
|
0
|
|
|
|
404
|
$ctx->{log}->($ctx, 'exec', $var, "assign to elem $v1 %s (%s[%s]) = %s (%s) -> resolved elem-parent: %s elem-val: %s", $parser->stmt_str($v1), $basevar, defined $idxstr ? $idxstr : '-', $v2, $op2, defined $parent ? $parent : '-', defined $basestr ? $basestr : '-') if $ctx->{log}; |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
3573
|
|
|
|
|
|
|
|
3574
|
148
|
100
|
66
|
|
|
619
|
if (!$has_index) { |
|
|
100
|
66
|
|
|
|
|
|
|
100
|
66
|
|
|
|
|
|
|
|
66
|
|
|
|
|
3575
|
25
|
100
|
|
|
|
83
|
if ($ctx->is_unresolved_assignment($op2)) { |
3576
|
5
|
|
|
|
|
18
|
$ctx->setvar($basevar, "#unresolved", $in_block); |
3577
|
|
|
|
|
|
|
} else { |
3578
|
20
|
|
|
|
|
73
|
$ctx->setvar($basevar, $op2, $in_block); |
3579
|
|
|
|
|
|
|
} |
3580
|
25
|
|
|
|
|
140
|
return $parser->setexpr('=', $basevar, $op2); |
3581
|
|
|
|
|
|
|
} elsif (defined $basestr && is_strval($basestr) && !is_null($basestr) && defined $idxstr) { |
3582
|
3
|
50
|
|
|
|
21
|
if (is_strval($op2)) { |
3583
|
|
|
|
|
|
|
# also allowed to change chars past end of string |
3584
|
|
|
|
|
|
|
# (changing an empty '' string should silently allocate |
3585
|
|
|
|
|
|
|
# an array variable) |
3586
|
|
|
|
|
|
|
# https://php.net/manual/en/language.types.string.php |
3587
|
|
|
|
|
|
|
# |
3588
|
3
|
|
|
|
|
12
|
my $str = $parser->{strmap}->{$basestr}; |
3589
|
3
|
|
|
|
|
8
|
my $pos = $parser->{strmap}->{$idxstr}; |
3590
|
3
|
|
|
|
|
7
|
my $ch = $parser->{strmap}->{$op2}; |
3591
|
|
|
|
|
|
|
|
3592
|
|
|
|
|
|
|
# todo: $pos might be non-numeric array-key here |
3593
|
|
|
|
|
|
|
# |
3594
|
3
|
|
|
|
|
14
|
eval { substr($str, $pos, 1) = $ch; }; |
|
3
|
|
|
|
|
12
|
|
3595
|
3
|
50
|
|
|
|
8
|
if ($@) { |
3596
|
0
|
|
|
|
|
0
|
$ctx->{warn}->($ctx, 'exec', $var, "assign to elem $v1: bad set substr(%s, %s, 1) = %s", $str, $pos, $ch); |
3597
|
|
|
|
|
|
|
} |
3598
|
3
|
|
|
|
|
8
|
my $k = $parser->setstr($str); |
3599
|
3
|
|
|
|
|
12
|
$ctx->setvar($v, $k, $in_block); |
3600
|
|
|
|
|
|
|
|
3601
|
3
|
50
|
|
|
|
18
|
$ctx->{log}->($ctx, 'exec', $var, "assign to elem $v1: setstr %s [%s] (%s, %s) = %s -> %s", $basevar, $parent, $pos, $ch, $str, $k) if $ctx->{log}; |
3602
|
3
|
|
|
|
|
14
|
return $parser->setexpr('=', $v, $k); |
3603
|
|
|
|
|
|
|
} |
3604
|
|
|
|
|
|
|
} elsif (!defined $basestr || is_array($basestr)) { |
3605
|
118
|
50
|
|
|
|
254
|
if (defined $basestr) { |
3606
|
118
|
|
|
|
|
247
|
my $arr = $parser->{strmap}{$basestr}; |
3607
|
118
|
100
|
|
|
|
337
|
if (!defined $idxstr) { |
|
|
100
|
|
|
|
|
|
3608
|
|
|
|
|
|
|
# $arr[] = val - appends at end of array |
3609
|
|
|
|
|
|
|
# |
3610
|
25
|
100
|
|
|
|
72
|
if ($ctx->is_unresolved_assignment($op2)) { |
3611
|
|
|
|
|
|
|
# mark variable as unresolved if rhs is not resolvable |
3612
|
|
|
|
|
|
|
# |
3613
|
4
|
|
|
|
|
14
|
$ctx->setvar($basevar, '#unresolved', $in_block); |
3614
|
4
|
|
|
|
|
33
|
$arr->set(undef, $v2); |
3615
|
4
|
50
|
|
|
|
16
|
$ctx->{log}->($ctx, 'exec', $var, "assign to elem $v1 set: %s[] = %s -> #unresolved", $v, $op2) if $ctx->{log}; |
3616
|
|
|
|
|
|
|
} else { |
3617
|
21
|
|
|
|
|
107
|
$arr->set(undef, $op2); |
3618
|
21
|
50
|
|
|
|
79
|
$ctx->{log}->($ctx, 'exec', $var, "assign to elem $v1 set: %s[] = %s", $v, $op2) if $ctx->{log}; |
3619
|
|
|
|
|
|
|
} |
3620
|
|
|
|
|
|
|
} elsif (is_strval($idxstr)) { |
3621
|
92
|
|
|
|
|
218
|
my $key = $idxstr; |
3622
|
92
|
100
|
|
|
|
252
|
if ($ctx->is_unresolved_assignment($op2)) { |
|
|
100
|
|
|
|
|
|
3623
|
7
|
|
|
|
|
32
|
$ctx->setvar($basevar, '#unresolved', $in_block); |
3624
|
7
|
|
|
|
|
41
|
$arr->set($key, $v2); |
3625
|
7
|
50
|
|
|
|
35
|
$ctx->{log}->($ctx, 'exec', $var, "assign to elem $v1 set: %s[%s] = %s -> #unresolved", $v, $idxstr, $v2) if $ctx->{log}; |
3626
|
|
|
|
|
|
|
} elsif (is_null($idxstr)) { |
3627
|
5
|
|
|
|
|
18
|
$key = $parser->setstr(''); # null maps to '' array index |
3628
|
5
|
|
|
|
|
21
|
$arr->set($key, $op2); |
3629
|
5
|
50
|
|
|
|
18
|
$ctx->{log}->($ctx, 'exec', $var, "assign to elem $v1 set: %s[null] = %s", $v, $op2) if $ctx->{log}; |
3630
|
|
|
|
|
|
|
} else { |
3631
|
80
|
|
|
|
|
328
|
$arr->set($key, $op2); |
3632
|
80
|
50
|
|
|
|
342
|
$ctx->{log}->($ctx, 'exec', $var, "assign to elem $v1 set: %s[%s] = %s", $v, $idxstr, $op2) if $ctx->{log}; |
3633
|
|
|
|
|
|
|
} |
3634
|
|
|
|
|
|
|
} |
3635
|
|
|
|
|
|
|
} else { |
3636
|
0
|
0
|
|
|
|
0
|
if ($ctx->is_unresolved_assignment($op2)) { |
3637
|
0
|
|
|
|
|
0
|
$ctx->setvar($basevar, '#unresolved', $in_block); |
3638
|
|
|
|
|
|
|
} |
3639
|
|
|
|
|
|
|
} |
3640
|
|
|
|
|
|
|
|
3641
|
|
|
|
|
|
|
# keep the index-syntax instead of an array assignment. |
3642
|
|
|
|
|
|
|
# -> $x['a']['b'] = 'foo' versus $x['a'] = array('b' => 'foo') |
3643
|
|
|
|
|
|
|
# |
3644
|
118
|
50
|
|
|
|
374
|
if (exists $ctx->{simplify}{expr}) { |
3645
|
118
|
|
|
|
|
224
|
my $op1 = $v1; |
3646
|
118
|
100
|
100
|
|
|
566
|
if (($v ne $parent) || (defined $idxstr && ($i ne $idxstr))) { |
|
|
|
100
|
|
|
|
|
3647
|
|
|
|
|
|
|
# don't simplify obj-var to inst-var here |
3648
|
|
|
|
|
|
|
# |
3649
|
42
|
100
|
100
|
|
|
114
|
if (!is_instvar($parent) && !is_instvar($basevar)) { |
3650
|
40
|
|
|
|
|
159
|
$op1 = $parser->setelem($parent, $idxstr); |
3651
|
|
|
|
|
|
|
} |
3652
|
|
|
|
|
|
|
} |
3653
|
118
|
100
|
66
|
|
|
347
|
if ($in_block || !exists $ctx->{varhist}) { |
3654
|
108
|
100
|
100
|
|
|
369
|
if (($v1 ne $op1) || ($v2 ne $op2)) { |
3655
|
61
|
|
|
|
|
175
|
my $k = $parser->setexpr('=', $op1, $op2); |
3656
|
61
|
50
|
|
|
|
157
|
$ctx->{log}->($ctx, 'exec', $var, "simplify assign to elem $v1 %s ($op1) = $v2 ($op2) -> $k (stmt)", $parser->stmt_str($v1)) if $ctx->{log}; |
3657
|
61
|
|
|
|
|
259
|
return $k; |
3658
|
|
|
|
|
|
|
} |
3659
|
47
|
|
|
|
|
195
|
return $var; |
3660
|
|
|
|
|
|
|
} |
3661
|
|
|
|
|
|
|
|
3662
|
|
|
|
|
|
|
# track elem assignments in expressions |
3663
|
|
|
|
|
|
|
# |
3664
|
10
|
100
|
66
|
|
|
40
|
if (($v1 ne $op1) || ($v2 ne $op2)) { |
3665
|
3
|
50
|
|
|
|
15
|
$ctx->{log}->($ctx, 'exec', $var, "simplify assign to elem $v1 %s ($op1) = $v2 -> $op2 [TRACK]", $parser->stmt_str($v1)) if $ctx->{log}; |
3666
|
|
|
|
|
|
|
} else { |
3667
|
7
|
50
|
|
|
|
20
|
$ctx->{log}->($ctx, 'exec', $var, "assign to elem $v1 = $v2 -> $v2 [TRACK]") if $ctx->{log}; |
3668
|
|
|
|
|
|
|
} |
3669
|
10
|
|
|
|
|
36
|
$ctx->track_assignment($op1, $op2); |
3670
|
|
|
|
|
|
|
|
3671
|
10
|
100
|
66
|
|
|
38
|
if (is_strval($op2) || is_array($op2)) { |
3672
|
9
|
|
|
|
|
43
|
return $op2; |
3673
|
|
|
|
|
|
|
} |
3674
|
1
|
|
|
|
|
5
|
return $op1; |
3675
|
|
|
|
|
|
|
} |
3676
|
0
|
|
|
|
|
0
|
return $var; |
3677
|
|
|
|
|
|
|
} |
3678
|
|
|
|
|
|
|
} |
3679
|
2
|
|
|
|
|
14
|
$ctx->{warn}->($ctx, 'exec', $var, "assign to elem $v1: %s not found", $parser->stmt_str($v1)); |
3680
|
|
|
|
|
|
|
} elsif ($v1 =~ /^#arr\d+$/) { |
3681
|
|
|
|
|
|
|
# list($a,$b) = array(..) |
3682
|
|
|
|
|
|
|
# |
3683
|
8
|
|
|
|
|
23
|
my $arr_d = $parser->{strmap}{$v1}; |
3684
|
8
|
|
|
|
|
24
|
my $keys_d = $arr_d->get_keys(); |
3685
|
|
|
|
|
|
|
|
3686
|
8
|
|
|
|
|
35
|
my $arr_s; |
3687
|
8
|
100
|
|
|
|
28
|
if (is_array($op2)) { |
|
|
100
|
|
|
|
|
|
3688
|
6
|
|
|
|
|
22
|
$arr_s = $parser->{strmap}{$op2}; |
3689
|
|
|
|
|
|
|
} elsif (is_strval($op2)) { |
3690
|
|
|
|
|
|
|
# string or null list assignment sets all values to null |
3691
|
1
|
|
|
|
|
4
|
$arr_s = $parser->newarr(); |
3692
|
|
|
|
|
|
|
} |
3693
|
8
|
100
|
|
|
|
37
|
if (defined $arr_s) { |
3694
|
7
|
|
|
|
|
16
|
my $keys_s = $arr_s->get_keys(); |
3695
|
7
|
|
|
|
|
32
|
my $newarr = $parser->newarr(); |
3696
|
7
|
|
|
|
|
34
|
foreach my $k (@$keys_d) { |
3697
|
15
|
|
|
|
|
49
|
my $dst = $arr_d->val($k); |
3698
|
15
|
100
|
|
|
|
48
|
next if (!defined $dst); |
3699
|
14
|
|
|
|
|
45
|
my $src = $arr_s->get($k); |
3700
|
14
|
100
|
|
|
|
45
|
if (defined $src) { |
3701
|
12
|
100
|
|
|
|
33
|
if (is_variable($dst)) { |
|
|
50
|
|
|
|
|
|
3702
|
10
|
50
|
|
|
|
29
|
if ($ctx->is_unresolved_assignment($src)) { |
3703
|
0
|
|
|
|
|
0
|
$ctx->setvar($dst, '#unresolved', $in_block); |
3704
|
0
|
|
|
|
|
0
|
$ctx->{warn}->($ctx, 'exec', $var, "set array key $k ($dst) is unref"); |
3705
|
|
|
|
|
|
|
} else { |
3706
|
10
|
|
|
|
|
40
|
$ctx->setvar($dst, $src, $in_block); |
3707
|
|
|
|
|
|
|
} |
3708
|
|
|
|
|
|
|
} elsif ($dst =~ /^#elem\d+$/) { |
3709
|
2
|
|
|
|
|
10
|
my ($v, $i) = @{$parser->{strmap}{$dst}}; |
|
2
|
|
|
|
|
10
|
|
3710
|
2
|
50
|
|
|
|
7
|
$ctx->{log}->($ctx, 'exec', $var, "assign to array $v1 = $op2 -> key $k ($dst) is elem") if $ctx->{log}; |
3711
|
|
|
|
|
|
|
|
3712
|
2
|
|
|
|
|
7
|
my $sub = $parser->setexpr('=', $dst, $src); |
3713
|
2
|
|
|
|
|
12
|
my $had_assigns = $ctx->have_assignments(); |
3714
|
2
|
|
|
|
|
9
|
$src = $ctx->exec_statement($sub); |
3715
|
2
|
50
|
|
|
|
18
|
if (!$had_assigns) { |
3716
|
|
|
|
|
|
|
# remove any pending assignments, to avoid variable |
3717
|
|
|
|
|
|
|
# insertion for the 'sub'-assignmenmt. |
3718
|
|
|
|
|
|
|
# The full array assignment is inserted after the loop |
3719
|
|
|
|
|
|
|
# |
3720
|
2
|
|
|
|
|
112
|
$ctx->discard_pending_assignments(); |
3721
|
|
|
|
|
|
|
} |
3722
|
|
|
|
|
|
|
} |
3723
|
12
|
|
|
|
|
43
|
$newarr->set($k, $src); |
3724
|
|
|
|
|
|
|
} |
3725
|
|
|
|
|
|
|
} |
3726
|
7
|
100
|
66
|
|
|
57
|
if ($in_block || !exists $ctx->{varhist}) { |
3727
|
4
|
50
|
|
|
|
18
|
if (($v2 ne $op2)) { |
3728
|
0
|
|
|
|
|
0
|
my $k = $parser->setexpr('=', $v1, $op2); |
3729
|
0
|
0
|
|
|
|
0
|
$ctx->{log}->($ctx, 'exec', $var, "simplify assign to array $v1 = $v2 ($op2) -> $k") if $ctx->{log}; |
3730
|
0
|
|
|
|
|
0
|
return $k; |
3731
|
|
|
|
|
|
|
} |
3732
|
4
|
|
|
|
|
20
|
return $var; |
3733
|
|
|
|
|
|
|
} |
3734
|
3
|
|
|
|
|
15
|
return $newarr->{name}; |
3735
|
|
|
|
|
|
|
} |
3736
|
|
|
|
|
|
|
} |
3737
|
463
|
50
|
|
|
|
1245
|
if (exists $ctx->{simplify}{expr}) { |
3738
|
463
|
100
|
|
|
|
1011
|
if ($v1 =~ /^#elem\d+$/) { |
3739
|
2
|
|
|
|
|
8
|
$vv1 = $ctx->exec_statement($v1, $in_block); |
3740
|
2
|
50
|
|
|
|
7
|
if (!$ctx->is_superglobal($vv1)) { |
3741
|
2
|
50
|
33
|
|
|
6
|
if (!is_variable($vv1) && !($vv1 =~ /^#elem\d+$/)) { |
3742
|
0
|
|
|
|
|
0
|
$vv1 = $v1; |
3743
|
|
|
|
|
|
|
} |
3744
|
|
|
|
|
|
|
} |
3745
|
2
|
|
|
|
|
6
|
$vv1_sim = $vv1; |
3746
|
|
|
|
|
|
|
} |
3747
|
|
|
|
|
|
|
|
3748
|
463
|
100
|
100
|
|
|
1503
|
if (($v1 ne $vv1_sim) || ($v2 ne $op2)) { |
3749
|
|
|
|
|
|
|
# simplify expr |
3750
|
|
|
|
|
|
|
# |
3751
|
4
|
|
|
|
|
20
|
my $k = $parser->setexpr('=', $vv1_sim, $op2); |
3752
|
4
|
50
|
|
|
|
18
|
$ctx->{log}->($ctx, 'exec', $var, "simplify assign to $v1 ($vv1_sim) = $v2 ($op2) -> $k") if $ctx->{log}; |
3753
|
4
|
|
|
|
|
11
|
return $k; |
3754
|
|
|
|
|
|
|
} |
3755
|
|
|
|
|
|
|
} |
3756
|
459
|
|
|
|
|
1259
|
return $var; |
3757
|
|
|
|
|
|
|
} |
3758
|
588
|
|
|
|
|
1087
|
my $op1; |
3759
|
|
|
|
|
|
|
|
3760
|
588
|
100
|
|
|
|
1159
|
if (defined $v1) { |
3761
|
447
|
50
|
|
|
|
996
|
if ($v1 =~ /^#stmt\d+$/) { |
3762
|
0
|
|
|
|
|
0
|
$ctx->{warn}->($ctx, 'exec', $var, "first op $v1 is no expr"); |
3763
|
0
|
|
|
|
|
0
|
$op1 = $v1; |
3764
|
|
|
|
|
|
|
} else { |
3765
|
447
|
|
|
|
|
1492
|
$op1 = $ctx->exec_statement($v1, $in_block); |
3766
|
|
|
|
|
|
|
} |
3767
|
|
|
|
|
|
|
} |
3768
|
588
|
100
|
66
|
|
|
3450
|
if (!defined $v1 && defined $v2 && ($op eq 'new')) { |
|
|
100
|
100
|
|
|
|
|
|
|
100
|
66
|
|
|
|
|
|
|
100
|
66
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
66
|
|
|
|
|
3769
|
39
|
50
|
|
|
|
140
|
if ($v2 =~ /^#call\d+$/) { |
3770
|
39
|
|
|
|
|
72
|
my ($name0, $arglist) = @{$parser->{strmap}->{$v2}}; |
|
39
|
|
|
|
|
108
|
|
3771
|
|
|
|
|
|
|
|
3772
|
|
|
|
|
|
|
# new class() |
3773
|
|
|
|
|
|
|
# - class properties are initialized when exec(#class) is called |
3774
|
|
|
|
|
|
|
# |
3775
|
39
|
|
|
|
|
135
|
my ($args, $arg_changed) = $ctx->resolve_arglist($arglist, [], $in_block); |
3776
|
39
|
|
|
|
|
113
|
my $name = lc($name0); |
3777
|
|
|
|
|
|
|
|
3778
|
39
|
|
|
|
|
91
|
$name = $ctx->add_namespace($name); |
3779
|
|
|
|
|
|
|
|
3780
|
39
|
|
|
|
|
111
|
my $class = $ctx->getclass($name); |
3781
|
39
|
100
|
100
|
|
|
174
|
if (defined $class && exists $ctx->{varmap}{inst}{$name}) { |
3782
|
34
|
|
|
|
|
71
|
my ($n, $b, $p) = @{$parser->{strmap}->{$class}}; |
|
34
|
|
|
|
|
99
|
|
3783
|
34
|
|
|
|
|
433
|
my $ctx2 = $ctx; |
3784
|
|
|
|
|
|
|
|
3785
|
34
|
50
|
|
|
|
83
|
$ctx->{log}->($ctx, 'new', $v2, "found class $class") if $ctx->{log}; |
3786
|
|
|
|
|
|
|
|
3787
|
|
|
|
|
|
|
# create class instance |
3788
|
|
|
|
|
|
|
# |
3789
|
34
|
|
|
|
|
51
|
my $c2 = $v2; |
3790
|
34
|
100
|
|
|
|
71
|
if ($arg_changed) { |
3791
|
1
|
50
|
|
|
|
4
|
my @argssim = map { ($args->[$_] =~ /^(#inst\d+)$/) ? $arglist->[$_] : $args->[$_] } 0..$#$args; |
|
1
|
|
|
|
|
9
|
|
3792
|
1
|
|
|
|
|
5
|
$c2 = $parser->setcall($name0, \@argssim); |
3793
|
|
|
|
|
|
|
} |
3794
|
34
|
|
|
|
|
114
|
my $inst = $parser->setinst($class, $c2, $ctx2); |
3795
|
34
|
|
|
|
|
73
|
$ctx2->{varmap}{inst}{$inst} = {}; # init instance var map |
3796
|
|
|
|
|
|
|
|
3797
|
34
|
50
|
|
|
|
77
|
$ctx->{log}->($ctx, 'new', $v2, "clone inst vars [%s]", join(', ', keys %{$ctx2->{varmap}{inst}{$name}})) if $ctx->{log}; |
|
0
|
|
|
|
|
0
|
|
3798
|
|
|
|
|
|
|
|
3799
|
|
|
|
|
|
|
# initialize instance vars with class properties |
3800
|
|
|
|
|
|
|
# |
3801
|
34
|
|
|
|
|
53
|
my %varmap = %{$ctx->{varmap}}; |
|
34
|
|
|
|
|
198
|
|
3802
|
34
|
|
|
|
|
70
|
$ctx2->{varmap}{inst}{$inst} = {%{$ctx2->{varmap}{inst}{$name}}}; # copy class var map |
|
34
|
|
|
|
|
116
|
|
3803
|
|
|
|
|
|
|
|
3804
|
|
|
|
|
|
|
# initialize instance methods class functions |
3805
|
|
|
|
|
|
|
# |
3806
|
34
|
|
|
|
|
50
|
my ($type, $memlist) = @{$parser->{strmap}->{$b}}; |
|
34
|
|
|
|
|
92
|
|
3807
|
34
|
|
|
|
|
105
|
foreach my $m (@$memlist) { |
3808
|
59
|
100
|
|
|
|
187
|
if ($m =~ /^#fun\d+$/) { |
3809
|
26
|
|
|
|
|
58
|
my ($f, $a, $b, $p) = @{$parser->{strmap}->{$m}}; |
|
26
|
|
|
|
|
74
|
|
3810
|
26
|
50
|
33
|
|
|
95
|
if (defined $f && is_symbol($f)) { |
3811
|
26
|
|
|
|
|
89
|
my $instvar = method_name($inst, lc($f)); # inst var default is class func |
3812
|
26
|
|
|
|
|
72
|
my $classfunc = method_name($name, lc($f)); |
3813
|
26
|
|
|
|
|
100
|
$ctx2->{varmap}{inst}{$inst}{lc($f)} = $classfunc; |
3814
|
26
|
50
|
|
|
|
82
|
$ctx->{log}->($ctx, 'new', $v2, "init inst func $instvar -> $classfunc") if $ctx->{log}; |
3815
|
|
|
|
|
|
|
} |
3816
|
|
|
|
|
|
|
} |
3817
|
|
|
|
|
|
|
} |
3818
|
|
|
|
|
|
|
|
3819
|
|
|
|
|
|
|
# constructor returns void |
3820
|
|
|
|
|
|
|
# |
3821
|
34
|
|
|
|
|
82
|
my $init = method_name($inst, '__construct'); |
3822
|
34
|
|
|
|
|
84
|
my $f = $ctx2->getfun($init); |
3823
|
34
|
100
|
|
|
|
109
|
if (!defined $f) { |
3824
|
|
|
|
|
|
|
# try old-style constructor (prior php80) |
3825
|
30
|
|
|
|
|
67
|
my $init2 = method_name($inst, $name); |
3826
|
30
|
|
|
|
|
60
|
$f = $ctx2->getfun($init2); |
3827
|
30
|
100
|
|
|
|
90
|
if (defined $f) { |
3828
|
2
|
50
|
|
|
|
9
|
$ctx->{log}->($ctx, 'new', $v2, "found oldstyle constructor $name") if $ctx->{log}; |
3829
|
2
|
|
|
|
|
7
|
$init = $init2; |
3830
|
|
|
|
|
|
|
} |
3831
|
|
|
|
|
|
|
} |
3832
|
34
|
100
|
|
|
|
69
|
if (defined $f) { |
3833
|
6
|
|
|
|
|
26
|
my $c = $parser->setcall($init, $arglist); |
3834
|
6
|
|
|
|
|
29
|
my $k = $ctx2->exec_statement($c); |
3835
|
|
|
|
|
|
|
# ignore void result |
3836
|
|
|
|
|
|
|
} |
3837
|
34
|
|
|
|
|
177
|
return $inst; |
3838
|
|
|
|
|
|
|
} |
3839
|
5
|
50
|
|
|
|
20
|
unless ($ctx->{incall}) { |
3840
|
5
|
50
|
|
|
|
29
|
if (exists $ctx->{simplify}{stmt}) { |
3841
|
5
|
50
|
|
|
|
20
|
if ($arg_changed) { |
3842
|
0
|
0
|
|
|
|
0
|
my @argssim = map { ($args->[$_] =~ /^(#inst\d+)$/) ? $arglist->[$_] : $args->[$_] } 0..$#$args; |
|
0
|
|
|
|
|
0
|
|
3843
|
0
|
|
|
|
|
0
|
my $c2 = $parser->setcall($name0, \@argssim); |
3844
|
0
|
0
|
|
|
|
0
|
if ($v2 ne $c2) { |
3845
|
0
|
|
|
|
|
0
|
my $k = $parser->setexpr('new', undef, $c2); |
3846
|
0
|
0
|
|
|
|
0
|
$ctx->{log}->($ctx, 'new', $v2, "simplify -> $k") if $ctx->{log}; |
3847
|
0
|
|
|
|
|
0
|
return $k; |
3848
|
|
|
|
|
|
|
} |
3849
|
|
|
|
|
|
|
} |
3850
|
|
|
|
|
|
|
} |
3851
|
|
|
|
|
|
|
} |
3852
|
|
|
|
|
|
|
} |
3853
|
|
|
|
|
|
|
} elsif (!defined $v1 && defined $v2) { |
3854
|
102
|
|
|
|
|
463
|
$op2 = $ctx->exec_statement($v2, $in_block); |
3855
|
|
|
|
|
|
|
|
3856
|
102
|
100
|
100
|
|
|
553
|
if ($op eq '$') { |
|
|
100
|
100
|
|
|
|
|
3857
|
48
|
|
|
|
|
176
|
my $var1 = $parser->varvar_to_var($op2); |
3858
|
48
|
100
|
|
|
|
147
|
if (defined $var1) { |
3859
|
42
|
|
|
|
|
107
|
return $ctx->exec_statement($var1); |
3860
|
|
|
|
|
|
|
} |
3861
|
6
|
50
|
|
|
|
30
|
if (exists $ctx->{simplify}{expr}) { |
3862
|
6
|
100
|
66
|
|
|
21
|
if (is_variable($op2) && ($v2 ne $op2)) { |
3863
|
|
|
|
|
|
|
# simplify expr |
3864
|
|
|
|
|
|
|
# |
3865
|
5
|
|
|
|
|
38
|
my $k = $parser->setexpr($op, undef, $op2); |
3866
|
5
|
50
|
|
|
|
32
|
$ctx->{log}->($ctx, 'exec', $var, "simplify varvar $v2 ($op2) -> $k") if $ctx->{log}; |
3867
|
5
|
|
|
|
|
17
|
return $k; |
3868
|
|
|
|
|
|
|
} |
3869
|
|
|
|
|
|
|
} |
3870
|
|
|
|
|
|
|
} elsif ((($op eq '--') || ($op eq '++')) && is_variable($v2)) { |
3871
|
|
|
|
|
|
|
# ++$var |
3872
|
|
|
|
|
|
|
# --$var |
3873
|
|
|
|
|
|
|
# |
3874
|
19
|
100
|
|
|
|
52
|
if (is_strval($op2)) { |
3875
|
18
|
|
|
|
|
77
|
my ($val, $result) = PHP::Decode::Op::unary($parser, $op, $op2); |
3876
|
|
|
|
|
|
|
|
3877
|
18
|
50
|
|
|
|
52
|
if (defined $val) { |
3878
|
18
|
50
|
|
|
|
44
|
$ctx->{log}->($ctx, 'exec', $var, "%s %s -> %s = %s", $op, $op2, $val, $result) if $ctx->{log}; |
3879
|
|
|
|
|
|
|
|
3880
|
18
|
|
|
|
|
47
|
my $k = $parser->setexpr('=', $v2, $val); |
3881
|
18
|
|
|
|
|
59
|
my $res = $ctx->exec_statement($k, $in_block); |
3882
|
18
|
|
|
|
|
55
|
return $res; |
3883
|
|
|
|
|
|
|
} |
3884
|
|
|
|
|
|
|
} else { |
3885
|
|
|
|
|
|
|
# remove from varmap to avoid later simplification |
3886
|
|
|
|
|
|
|
# |
3887
|
1
|
|
|
|
|
4
|
$ctx->setvar($v2, '#unresolved', $in_block); |
3888
|
|
|
|
|
|
|
} |
3889
|
|
|
|
|
|
|
} else { |
3890
|
35
|
100
|
100
|
|
|
114
|
if (is_strval($op2) || is_array($op2)) { |
3891
|
21
|
|
|
|
|
87
|
my ($k, $result) = PHP::Decode::Op::unary($parser, $op, $op2); |
3892
|
21
|
50
|
|
|
|
53
|
if (defined $k) { |
3893
|
21
|
50
|
|
|
|
58
|
$ctx->{log}->($ctx, 'exec', $var, "%s %s -> %s = %s", $op, $op2, $k, $result) if $ctx->{log}; |
3894
|
21
|
|
|
|
|
63
|
return $k; |
3895
|
|
|
|
|
|
|
} else { |
3896
|
0
|
|
|
|
|
0
|
$ctx->{warn}->($ctx, 'exec', $var, "%s %s -> failed", $op, $op2); |
3897
|
|
|
|
|
|
|
} |
3898
|
|
|
|
|
|
|
} |
3899
|
|
|
|
|
|
|
} |
3900
|
16
|
50
|
|
|
|
92
|
if (exists $ctx->{simplify}{expr}) { |
3901
|
16
|
50
|
|
|
|
52
|
if (is_instvar($op2)) { |
3902
|
0
|
|
|
|
|
0
|
$op2 = $v2; |
3903
|
|
|
|
|
|
|
} |
3904
|
16
|
100
|
|
|
|
79
|
if ($v2 ne $op2) { |
3905
|
|
|
|
|
|
|
# simplify expr |
3906
|
|
|
|
|
|
|
# |
3907
|
8
|
|
|
|
|
52
|
my $k = $parser->setexpr($op, undef, $op2); |
3908
|
8
|
50
|
|
|
|
37
|
$ctx->{log}->($ctx, 'exec', $var, "simplify unary $var: $op $v2 ($op2) -> $k") if $ctx->{log}; |
3909
|
8
|
|
|
|
|
23
|
return $k; |
3910
|
|
|
|
|
|
|
} |
3911
|
|
|
|
|
|
|
} |
3912
|
|
|
|
|
|
|
} elsif (defined $v1 && is_strval($op1) && !defined $v2) { |
3913
|
|
|
|
|
|
|
# $var++ |
3914
|
|
|
|
|
|
|
# $var-- |
3915
|
|
|
|
|
|
|
# |
3916
|
49
|
50
|
|
|
|
120
|
if (is_strval($op1)) { |
3917
|
49
|
|
|
|
|
198
|
my ($val, $result) = PHP::Decode::Op::unary($parser, $op, $op1); |
3918
|
49
|
50
|
|
|
|
131
|
if (defined $val) { |
3919
|
49
|
50
|
|
|
|
134
|
$ctx->{log}->($ctx, 'exec', $var, "%s %s -> %s = %s", $op1, $op, $val, $result) if $ctx->{log}; |
3920
|
|
|
|
|
|
|
|
3921
|
49
|
|
|
|
|
146
|
my $k = $parser->setexpr('=', $v1, $val); |
3922
|
49
|
|
|
|
|
180
|
my $res = $ctx->exec_statement($k, $in_block); |
3923
|
|
|
|
|
|
|
|
3924
|
|
|
|
|
|
|
# if assignment is tracked, return old value instead |
3925
|
|
|
|
|
|
|
# of new value here. |
3926
|
|
|
|
|
|
|
# |
3927
|
49
|
100
|
66
|
|
|
324
|
if (defined $res && ($res !~ /^#expr\d+$/)) { |
3928
|
27
|
|
|
|
|
47
|
$res = $op1; |
3929
|
|
|
|
|
|
|
} |
3930
|
49
|
|
|
|
|
171
|
return $res; |
3931
|
|
|
|
|
|
|
} |
3932
|
|
|
|
|
|
|
} else { |
3933
|
|
|
|
|
|
|
# remove from varmap to avoid later simplification |
3934
|
|
|
|
|
|
|
# |
3935
|
0
|
|
|
|
|
0
|
$ctx->setvar($v1, '#unresolved', $in_block); |
3936
|
|
|
|
|
|
|
} |
3937
|
|
|
|
|
|
|
} elsif (defined $v1 && defined $v2) { |
3938
|
384
|
50
|
|
|
|
766
|
if ($v1 =~ /^#stmt\d+$/) { |
3939
|
0
|
|
|
|
|
0
|
$ctx->{warn}->($ctx, 'exec', $var, "second op $v2 is no expr"); |
3940
|
0
|
|
|
|
|
0
|
$op2 = $v2; |
3941
|
|
|
|
|
|
|
} else { |
3942
|
384
|
100
|
66
|
|
|
3162
|
if (!$in_block && (($op eq '||') || ($op eq 'or') || ($op eq '&&') || ($op eq 'and') || ($op eq '?') || ($op eq ':'))) { |
|
|
|
66
|
|
|
|
|
3943
|
23
|
50
|
|
|
|
81
|
$ctx->{log}->($ctx, 'exec', $var, "set in_block for lazy or ordered evaluation") if $ctx->{log}; |
3944
|
23
|
|
|
|
|
40
|
$in_block = 1; |
3945
|
|
|
|
|
|
|
} |
3946
|
384
|
|
|
|
|
832
|
$op2 = $ctx->exec_statement($v2, $in_block); |
3947
|
|
|
|
|
|
|
} |
3948
|
|
|
|
|
|
|
|
3949
|
384
|
100
|
100
|
|
|
985
|
if ((is_strval($op1) || is_array($op1)) && (is_strval($op2) || is_array($op2))) { |
|
|
100
|
100
|
|
|
|
|
|
|
50
|
100
|
|
|
|
|
|
|
50
|
33
|
|
|
|
|
|
|
50
|
33
|
|
|
|
|
|
|
100
|
66
|
|
|
|
|
|
|
|
100
|
|
|
|
|
3950
|
254
|
100
|
66
|
|
|
983
|
if (($op ne '?') && ($op ne ':')) { |
3951
|
242
|
|
|
|
|
837
|
my ($k, $result) = PHP::Decode::Op::binary($parser, $op1, $op, $op2); |
3952
|
242
|
100
|
|
|
|
487
|
if (defined $k) { |
3953
|
241
|
50
|
|
|
|
627
|
$ctx->{log}->($ctx, 'exec', $var, "%s %s %s -> %s", $op1, $op, $op2, $k) if $ctx->{log}; |
3954
|
241
|
|
|
|
|
698
|
return $k; |
3955
|
|
|
|
|
|
|
} else { |
3956
|
1
|
|
|
|
|
8
|
$ctx->{warn}->($ctx, 'exec', $var, "%s %s %s -> failed", $op1, $op, $op2); |
3957
|
|
|
|
|
|
|
} |
3958
|
|
|
|
|
|
|
} |
3959
|
|
|
|
|
|
|
} elsif ($op eq '?') { |
3960
|
15
|
50
|
66
|
|
|
35
|
if ((is_strval($op1) || is_array($op1)) && ($op2 =~ /^#expr\d+$/) && ($parser->{strmap}->{$op2}->[0] eq ':')) { |
|
|
|
66
|
|
|
|
|
|
|
|
66
|
|
|
|
|
3961
|
|
|
|
|
|
|
# ternary: $expr1 ? $expr2 : $expr3 |
3962
|
|
|
|
|
|
|
# represented as [$op1 ? [$op2 : $op3]] |
3963
|
|
|
|
|
|
|
# |
3964
|
7
|
|
|
|
|
22
|
my $val = $parser->{strmap}{$op1}; |
3965
|
7
|
50
|
|
|
|
17
|
if (is_array($op1)) { |
3966
|
0
|
|
|
|
|
0
|
my $arr = $parser->{strmap}{$op1}; |
3967
|
0
|
|
|
|
|
0
|
$val = !$arr->empty(); |
3968
|
|
|
|
|
|
|
} |
3969
|
7
|
|
|
|
|
13
|
my $k; |
3970
|
7
|
100
|
|
|
|
15
|
if ($val) { |
3971
|
5
|
|
|
|
|
16
|
$k = $ctx->exec_statement($parser->{strmap}->{$op2}->[1]); |
3972
|
|
|
|
|
|
|
} else { |
3973
|
2
|
|
|
|
|
8
|
$k = $ctx->exec_statement($parser->{strmap}->{$op2}->[2]); |
3974
|
|
|
|
|
|
|
} |
3975
|
7
|
|
|
|
|
20
|
return $k; |
3976
|
|
|
|
|
|
|
} |
3977
|
|
|
|
|
|
|
} elsif (($op eq '===') && ($op1 eq '#null')) { |
3978
|
0
|
|
|
|
|
0
|
my $k = PHP::Decode::Func::exec_cmd($ctx, 'is_null', [$op2]); |
3979
|
0
|
0
|
|
|
|
0
|
if (defined $k) { |
3980
|
0
|
|
|
|
|
0
|
return $k; |
3981
|
|
|
|
|
|
|
} |
3982
|
|
|
|
|
|
|
} elsif (($op eq '===') && ($op2 eq '#null')) { |
3983
|
0
|
|
|
|
|
0
|
my $k = PHP::Decode::Func::exec_cmd($ctx, 'is_null', [$op1]); |
3984
|
0
|
0
|
|
|
|
0
|
if (defined $k) { |
3985
|
0
|
|
|
|
|
0
|
return $k; |
3986
|
|
|
|
|
|
|
} |
3987
|
|
|
|
|
|
|
} elsif (($op eq '==') && ($op1 eq '#null')) { |
3988
|
0
|
|
|
|
|
0
|
my $k = PHP::Decode::Func::exec_cmd($ctx, 'is_null_weak', [$op2]); |
3989
|
0
|
0
|
|
|
|
0
|
if (defined $k) { |
3990
|
0
|
|
|
|
|
0
|
return $k; |
3991
|
|
|
|
|
|
|
} |
3992
|
|
|
|
|
|
|
} elsif (($op eq '==') && ($op2 eq '#null')) { |
3993
|
1
|
|
|
|
|
6
|
my $k = PHP::Decode::Func::exec_cmd($ctx, 'is_null_weak', [$op1]); |
3994
|
1
|
50
|
|
|
|
4
|
if (defined $k) { |
3995
|
0
|
|
|
|
|
0
|
return $k; |
3996
|
|
|
|
|
|
|
} |
3997
|
|
|
|
|
|
|
} |
3998
|
|
|
|
|
|
|
|
3999
|
136
|
50
|
|
|
|
398
|
if (exists $ctx->{simplify}{expr}) { |
4000
|
136
|
50
|
|
|
|
286
|
if (is_instvar($op1)) { |
4001
|
0
|
|
|
|
|
0
|
$op1 = $v1; |
4002
|
|
|
|
|
|
|
} |
4003
|
136
|
50
|
|
|
|
262
|
if (is_instvar($op2)) { |
4004
|
0
|
|
|
|
|
0
|
$op2 = $v2; |
4005
|
|
|
|
|
|
|
} |
4006
|
136
|
100
|
100
|
|
|
520
|
if (($v1 ne $op1) || ($v2 ne $op2)) { |
4007
|
|
|
|
|
|
|
# simplify expr (no variable setting must occur) |
4008
|
|
|
|
|
|
|
# |
4009
|
40
|
|
|
|
|
138
|
my $k = $parser->setexpr($op, $op1, $op2); |
4010
|
40
|
50
|
|
|
|
125
|
$ctx->{log}->($ctx, 'exec', $var, "simplify binary %s (%s) %s %s (%s) -> %s", $v1, $op1, $op, $v2, $op2, $k) if $ctx->{log}; |
4011
|
40
|
|
|
|
|
126
|
return $k; |
4012
|
|
|
|
|
|
|
} |
4013
|
|
|
|
|
|
|
} |
4014
|
|
|
|
|
|
|
} |
4015
|
123
|
|
|
|
|
365
|
return $var; |
4016
|
|
|
|
|
|
|
} elsif ($var =~ /^#call\d+$/) { |
4017
|
733
|
|
|
|
|
1235
|
my ($name, $arglist) = @{$parser->{strmap}->{$var}}; |
|
733
|
|
|
|
|
2262
|
|
4018
|
733
|
|
|
|
|
1317
|
my $cmd = $name; |
4019
|
733
|
|
|
|
|
1238
|
my $cmdsim = $name; |
4020
|
|
|
|
|
|
|
|
4021
|
733
|
100
|
100
|
|
|
1564
|
if (is_variable($name) || ($name =~ /^#elem\d+$/) || ($name =~ /^#expr\d+$/) || ($name =~ /^#stmt\d+$/) || is_block($name)) { |
|
|
100
|
100
|
|
|
|
|
|
|
100
|
66
|
|
|
|
|
|
|
100
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
4022
|
26
|
|
|
|
|
73
|
my $s = $ctx->exec_statement($name); |
4023
|
26
|
100
|
|
|
|
156
|
if ($s =~ /^#fun\d+$/) { |
|
|
100
|
|
|
|
|
|
4024
|
8
|
|
|
|
|
17
|
$cmd = $s; |
4025
|
8
|
|
|
|
|
15
|
$cmdsim = $s; |
4026
|
|
|
|
|
|
|
} elsif (!is_null($s)) { |
4027
|
16
|
100
|
|
|
|
56
|
if (is_strval($s)) { |
4028
|
13
|
|
|
|
|
35
|
$cmd = $parser->{strmap}->{$s}; |
4029
|
|
|
|
|
|
|
} else { |
4030
|
3
|
|
|
|
|
14
|
$cmd = $s; |
4031
|
|
|
|
|
|
|
} |
4032
|
16
|
|
|
|
|
34
|
$cmdsim = $cmd; |
4033
|
|
|
|
|
|
|
} |
4034
|
26
|
50
|
|
|
|
76
|
$ctx->{log}->($ctx, 'exec', $var, "map %s (%s) -> %s", $name, $s, $cmd) if $ctx->{log}; |
4035
|
|
|
|
|
|
|
} elsif ($name =~ /^#obj\d+$/) { |
4036
|
28
|
|
|
|
|
136
|
my ($inst, $prop) = $ctx->resolve_obj($name); |
4037
|
28
|
100
|
|
|
|
82
|
if (defined $inst) { |
4038
|
18
|
50
|
|
|
|
45
|
if (is_symbol($prop)) { |
4039
|
18
|
|
|
|
|
41
|
$cmd = method_name($inst, $prop); |
4040
|
|
|
|
|
|
|
} else { |
4041
|
0
|
|
|
|
|
0
|
my ($o, $m) = @{$parser->{strmap}->{$name}}; |
|
0
|
|
|
|
|
0
|
|
4042
|
0
|
0
|
|
|
|
0
|
if ($m ne $prop) { |
4043
|
0
|
|
|
|
|
0
|
$cmdsim = $parser->setobj($o, $prop); |
4044
|
0
|
0
|
|
|
|
0
|
$ctx->{log}->($ctx, 'exec', $var, "obj simplify partial $name: -> $cmdsim") if $ctx->{log}; |
4045
|
|
|
|
|
|
|
} |
4046
|
|
|
|
|
|
|
} |
4047
|
|
|
|
|
|
|
} |
4048
|
28
|
50
|
|
|
|
86
|
$ctx->{log}->($ctx, 'exec', $var, "map obj %s -> %s", $name, $cmd) if $ctx->{log}; |
4049
|
|
|
|
|
|
|
} elsif ($name =~ /^#scope\d+$/) { |
4050
|
24
|
|
|
|
|
96
|
my ($scope, $val) = $ctx->resolve_scope($name); |
4051
|
24
|
100
|
|
|
|
72
|
if (defined $scope) { |
4052
|
21
|
50
|
|
|
|
60
|
if (is_symbol($val)) { |
4053
|
21
|
|
|
|
|
68
|
$cmd = method_name($scope, $val); |
4054
|
21
|
|
|
|
|
43
|
$cmdsim = $cmd; |
4055
|
|
|
|
|
|
|
} |
4056
|
|
|
|
|
|
|
} |
4057
|
24
|
50
|
|
|
|
77
|
$ctx->{log}->($ctx, 'exec', $var, "map scope %s -> %s", $name, $cmd) if $ctx->{log}; |
4058
|
|
|
|
|
|
|
} elsif ($name =~ /^#ns\d+$/) { |
4059
|
2
|
|
|
|
|
6
|
my ($ns, $val) = $ctx->resolve_ns($name); |
4060
|
2
|
50
|
|
|
|
15
|
if (defined $ns) { |
4061
|
2
|
|
|
|
|
8
|
$cmd = $parser->ns_to_str($name); |
4062
|
2
|
|
|
|
|
13
|
$cmdsim = $cmd; |
4063
|
|
|
|
|
|
|
} |
4064
|
2
|
50
|
|
|
|
21
|
$ctx->{log}->($ctx, 'exec', $var, "map ns %s -> %s", $name, $cmd) if $ctx->{log}; |
4065
|
|
|
|
|
|
|
} elsif (is_symbol($name)) { |
4066
|
635
|
|
|
|
|
1011
|
$cmd = $name; |
4067
|
635
|
|
|
|
|
881
|
$cmdsim = $cmd; |
4068
|
|
|
|
|
|
|
} |
4069
|
|
|
|
|
|
|
|
4070
|
|
|
|
|
|
|
# function passed by name, by reference or anonymous function |
4071
|
|
|
|
|
|
|
# |
4072
|
733
|
|
|
|
|
1395
|
my $fun; |
4073
|
733
|
100
|
|
|
|
1760
|
$fun = $cmd if ($cmd =~ /^#fun\d+$/); |
4074
|
733
|
100
|
|
|
|
1504
|
unless (defined $fun) { |
4075
|
722
|
|
|
|
|
1724
|
my $ncmd = $ctx->add_namespace($cmd); |
4076
|
722
|
|
|
|
|
1586
|
$fun = $ctx->getfun($ncmd); |
4077
|
722
|
100
|
|
|
|
1403
|
if (defined $fun) { |
4078
|
198
|
|
|
|
|
353
|
$cmd = $ncmd; |
4079
|
|
|
|
|
|
|
} |
4080
|
|
|
|
|
|
|
} |
4081
|
733
|
100
|
|
|
|
1356
|
if (defined $fun) { |
4082
|
209
|
|
|
|
|
586
|
my $cmd1 = _is_wrapped_call($parser, $fun); |
4083
|
209
|
100
|
|
|
|
456
|
if (defined $cmd1) { |
4084
|
4
|
50
|
|
|
|
12
|
$ctx->{log}->($ctx, 'exec', $var, "map wrapped %s -> %s", $cmd, $cmd1) if $ctx->{log}; |
4085
|
4
|
|
|
|
|
8
|
$cmd = $cmd1; |
4086
|
4
|
|
|
|
|
7
|
$cmdsim = $cmd1; |
4087
|
4
|
|
|
|
|
10
|
$fun = $ctx->getfun($cmd); |
4088
|
|
|
|
|
|
|
} |
4089
|
|
|
|
|
|
|
} |
4090
|
|
|
|
|
|
|
|
4091
|
733
|
|
|
|
|
1458
|
my $args = []; |
4092
|
733
|
|
|
|
|
1156
|
my $arg_changed = 0; |
4093
|
|
|
|
|
|
|
|
4094
|
733
|
100
|
66
|
|
|
3330
|
if (defined $fun) { |
|
|
100
|
66
|
|
|
|
|
|
|
100
|
|
|
|
|
|
4095
|
205
|
50
|
|
|
|
472
|
unless (exists $ctx->{skip}{call}) { |
4096
|
205
|
|
|
|
|
297
|
my ($_name, $param, $block, $p) = @{$parser->{strmap}->{$fun}}; |
|
205
|
|
|
|
|
573
|
|
4097
|
|
|
|
|
|
|
|
4098
|
205
|
|
|
|
|
560
|
($args, $arg_changed) = $ctx->resolve_arglist($arglist, $param, $in_block); |
4099
|
|
|
|
|
|
|
|
4100
|
205
|
|
|
|
|
640
|
my ($key, $code); |
4101
|
205
|
50
|
|
|
|
553
|
if (exists $ctx->{with}{translate}) { |
4102
|
0
|
|
|
|
|
0
|
my $perl = $parser->translate_func($fun, undef, 0); |
4103
|
0
|
0
|
|
|
|
0
|
if (defined $perl) { |
4104
|
0
|
0
|
|
|
|
0
|
$ctx->{log}->($ctx, 'exec', $var, "translated $fun -> $perl") if $ctx->{log}; |
4105
|
0
|
|
|
|
|
0
|
my $sub = eval($perl); |
4106
|
0
|
0
|
|
|
|
0
|
if ($@) { |
4107
|
0
|
|
|
|
|
0
|
$ctx->{warn}->($ctx, 'exec', $var, "eval $fun failed: $@"); |
4108
|
|
|
|
|
|
|
} else { |
4109
|
0
|
0
|
0
|
|
|
0
|
if ((scalar @$args == 1) && is_strval($args->[0])) { |
4110
|
0
|
|
|
|
|
0
|
my $val = $parser->{strmap}->{$args->[0]}; |
4111
|
0
|
|
|
|
|
0
|
my $res = eval { &$sub($val) }; |
|
0
|
|
|
|
|
0
|
|
4112
|
0
|
0
|
|
|
|
0
|
if ($@) { |
4113
|
0
|
|
|
|
|
0
|
$ctx->{warn}->($ctx, 'exec', $var, "eval $fun ERR: %s", $@); |
4114
|
|
|
|
|
|
|
} else { |
4115
|
0
|
0
|
|
|
|
0
|
$ctx->{log}->($ctx, 'exec', $var, "eval $fun => %s", defined $res ? $res : 'undef') if $ctx->{log}; |
|
|
0
|
|
|
|
|
|
4116
|
0
|
0
|
|
|
|
0
|
if (defined $res) { |
4117
|
|
|
|
|
|
|
#if ($res =~ /^[0-9][0-9\.]+$/) { |
4118
|
0
|
0
|
|
|
|
0
|
if ($res =~ /^[0-9]+$/) { |
4119
|
0
|
|
|
|
|
0
|
$key = $parser->setnum($res); |
4120
|
|
|
|
|
|
|
} else { |
4121
|
0
|
|
|
|
|
0
|
$key = $parser->setstr($res); |
4122
|
|
|
|
|
|
|
} |
4123
|
0
|
|
|
|
|
0
|
$code = ''; |
4124
|
|
|
|
|
|
|
} |
4125
|
|
|
|
|
|
|
} |
4126
|
|
|
|
|
|
|
} |
4127
|
|
|
|
|
|
|
} |
4128
|
|
|
|
|
|
|
} |
4129
|
|
|
|
|
|
|
} |
4130
|
205
|
50
|
|
|
|
442
|
unless (defined $key) { |
4131
|
205
|
|
|
|
|
518
|
($key, $code) = $ctx->exec_func($cmd, $args, $param, $block); |
4132
|
|
|
|
|
|
|
} |
4133
|
205
|
100
|
|
|
|
565
|
if (!defined $key) { |
4134
|
5
|
50
|
|
|
|
30
|
my $info = $ctx->get_unresolved_info($cmd, defined $code ? $code : $block); |
4135
|
|
|
|
|
|
|
|
4136
|
5
|
50
|
|
|
|
36
|
unless (keys %{$info->{unresolved}}) { |
|
5
|
|
|
|
|
23
|
|
4137
|
5
|
50
|
|
|
|
19
|
$ctx->{warn}->($ctx, 'func', $cmd, "%s executed (but no additional taint) (globals[%s])", defined $code ? 'partially' : 'not', join(' ', keys %{$info->{global_assigns}})); |
|
5
|
|
|
|
|
32
|
|
4138
|
5
|
|
|
|
|
225
|
$ctx->set_globals_unresolved([keys %{$info->{global_assigns}}]); |
|
5
|
|
|
|
|
41
|
|
4139
|
5
|
|
|
|
|
26
|
$key = '#notaint'; |
4140
|
|
|
|
|
|
|
} else { |
4141
|
0
|
0
|
|
|
|
0
|
$ctx->{warn}->($ctx, 'func', $cmd, "%s executed (unresolved[%s] globals[%s])", defined $code ? 'partially' : 'not', join(' ', keys %{$info->{unresolved}}), join(' ', keys %{$info->{global_assigns}})); |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
4142
|
|
|
|
|
|
|
} |
4143
|
|
|
|
|
|
|
} |
4144
|
205
|
50
|
|
|
|
440
|
if (defined $key) { |
4145
|
|
|
|
|
|
|
# register exposed funcs |
4146
|
|
|
|
|
|
|
# |
4147
|
205
|
100
|
|
|
|
372
|
if (defined $code) { |
4148
|
181
|
100
|
|
|
|
536
|
if (is_block($code)) { |
4149
|
169
|
|
|
|
|
248
|
my ($type, $a) = @{$parser->{strmap}->{$code}}; |
|
169
|
|
|
|
|
534
|
|
4150
|
169
|
|
|
|
|
431
|
register_funcs($a, $ctx, $parser); |
4151
|
|
|
|
|
|
|
} else { |
4152
|
12
|
|
|
|
|
44
|
register_funcs([$code], $ctx, $parser); |
4153
|
|
|
|
|
|
|
} |
4154
|
|
|
|
|
|
|
} |
4155
|
205
|
100
|
|
|
|
513
|
if ($key ne '#construct') { |
4156
|
199
|
|
|
|
|
335
|
my $name_changed = 0; |
4157
|
199
|
100
|
|
|
|
405
|
if ($cmd ne $name) { |
4158
|
|
|
|
|
|
|
# expand anonymous function if not variable in #call |
4159
|
|
|
|
|
|
|
# |
4160
|
56
|
100
|
100
|
|
|
252
|
if (($cmd =~ /^#fun\d+$/) && is_variable($name)) { |
|
|
50
|
|
|
|
|
|
4161
|
6
|
|
|
|
|
18
|
$cmd = $name; |
4162
|
|
|
|
|
|
|
} elsif (is_instvar($cmd)) { |
4163
|
|
|
|
|
|
|
# don't simplify obj-var to inst-var here |
4164
|
0
|
|
|
|
|
0
|
$cmd = $name; |
4165
|
|
|
|
|
|
|
} else { |
4166
|
50
|
|
|
|
|
97
|
$name_changed = 1; |
4167
|
|
|
|
|
|
|
} |
4168
|
|
|
|
|
|
|
} |
4169
|
|
|
|
|
|
|
|
4170
|
|
|
|
|
|
|
# insert simplified or anonymous function |
4171
|
|
|
|
|
|
|
# (but keep calls in lazy evaluated expressions like '$x || f()') |
4172
|
|
|
|
|
|
|
# |
4173
|
199
|
|
|
|
|
290
|
my $c; |
4174
|
199
|
|
|
|
|
496
|
my $v = '$'.'eval'.'$'.$cmd; |
4175
|
|
|
|
|
|
|
#my $v = '$'.'call'.'$'.$cmd; |
4176
|
199
|
100
|
100
|
|
|
760
|
if (defined $code && !$in_block) { |
4177
|
173
|
|
|
|
|
346
|
$c = $code; |
4178
|
|
|
|
|
|
|
} else { |
4179
|
26
|
100
|
100
|
|
|
150
|
if ($name_changed || $arg_changed) { |
4180
|
13
|
50
|
|
|
|
57
|
my @argssim = map { ($args->[$_] =~ /^(#inst\d+)$/) ? $arglist->[$_] : $args->[$_] } 0..$#$args; |
|
8
|
|
|
|
|
54
|
|
4181
|
13
|
|
|
|
|
48
|
$c = $parser->setcall($cmdsim, \@argssim); |
4182
|
|
|
|
|
|
|
} else { |
4183
|
13
|
|
|
|
|
34
|
$c = $var; |
4184
|
|
|
|
|
|
|
} |
4185
|
|
|
|
|
|
|
} |
4186
|
199
|
100
|
|
|
|
505
|
if ($key eq '#notaint') { |
|
|
100
|
|
|
|
|
|
4187
|
7
|
|
|
|
|
26
|
$key = $c; |
4188
|
|
|
|
|
|
|
} elsif ($in_block) { |
4189
|
4
|
50
|
33
|
|
|
12
|
if ((is_strval($key) || is_array($key) || _anon_func_call($parser, $key)) && defined $code && $parser->is_empty_block($code)) { |
|
|
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
4190
|
|
|
|
|
|
|
# keep simple key & ignore call if no code to inline is left |
4191
|
0
|
0
|
|
|
|
0
|
$ctx->{log}->($ctx, 'exec', $var, "%s(%s) -> keep key $key and ignore empty code $code", $cmd, join(' , ', @$arglist)) if $ctx->{log}; |
4192
|
|
|
|
|
|
|
} else { |
4193
|
4
|
|
|
|
|
9
|
$key = $c; |
4194
|
|
|
|
|
|
|
} |
4195
|
|
|
|
|
|
|
} else { |
4196
|
188
|
|
|
|
|
581
|
$ctx->track_assignment($v, $c); |
4197
|
|
|
|
|
|
|
|
4198
|
|
|
|
|
|
|
# void functions return 'null'. If null is not assigned, |
4199
|
|
|
|
|
|
|
# it will be removed in later flatten_block() calls. |
4200
|
|
|
|
|
|
|
# |
4201
|
188
|
100
|
|
|
|
499
|
if ($key eq '#noreturn') { |
4202
|
62
|
|
|
|
|
121
|
$key = '#null'; |
4203
|
|
|
|
|
|
|
} |
4204
|
|
|
|
|
|
|
} |
4205
|
|
|
|
|
|
|
} |
4206
|
205
|
100
|
|
|
|
428
|
if ($key eq '#construct') { |
4207
|
|
|
|
|
|
|
# insert simplified anonymous function here |
4208
|
|
|
|
|
|
|
# |
4209
|
6
|
|
|
|
|
20
|
my $methodname = $ctx->lookup_method_name($cmd); |
4210
|
6
|
50
|
|
|
|
23
|
if (defined $methodname) { |
4211
|
6
|
|
|
|
|
18
|
my ($classname, $prop) = method_split($methodname); |
4212
|
6
|
|
|
|
|
16
|
my $f; |
4213
|
6
|
50
|
|
|
|
16
|
unless ($f = _anon_func_call($parser, $code)) { |
4214
|
6
|
|
|
|
|
22
|
$f = $parser->setfun(undef, [], $code); |
4215
|
|
|
|
|
|
|
} |
4216
|
6
|
|
|
|
|
33
|
my $v = '$__'.$classname.'_'.'__construct'; |
4217
|
6
|
|
|
|
|
21
|
$ctx->track_assignment($v, $f); # always track this variable |
4218
|
|
|
|
|
|
|
} |
4219
|
|
|
|
|
|
|
} |
4220
|
205
|
0
|
|
|
|
459
|
$ctx->{log}->($ctx, 'exec', $var, "%s(%s) -> %s [%s]", $cmd, join(' , ', @$arglist), $key, defined $code ? $code : '-') if $ctx->{log}; |
|
|
50
|
|
|
|
|
|
4221
|
205
|
|
|
|
|
727
|
return $key; |
4222
|
|
|
|
|
|
|
} else { |
4223
|
0
|
|
|
|
|
0
|
$ctx->set_tainted($var); |
4224
|
0
|
|
|
|
|
0
|
$ctx->invalidate_arglist_refs($arglist, $param, $in_block); |
4225
|
|
|
|
|
|
|
} |
4226
|
|
|
|
|
|
|
} else { |
4227
|
0
|
|
|
|
|
0
|
$ctx->set_tainted($var); |
4228
|
|
|
|
|
|
|
} |
4229
|
|
|
|
|
|
|
} elsif ((lc($cmd) eq 'eval') && (scalar @$arglist == 1)) { |
4230
|
56
|
|
|
|
|
191
|
($args, $arg_changed) = $ctx->resolve_arglist($arglist, [], $in_block); |
4231
|
|
|
|
|
|
|
|
4232
|
|
|
|
|
|
|
# linenum restarts with line 1 for each eval() and is increased |
4233
|
|
|
|
|
|
|
# for each newline in evalstring (verified with php). |
4234
|
|
|
|
|
|
|
# (the __FILE__ content keeps the same) |
4235
|
|
|
|
|
|
|
# |
4236
|
56
|
|
|
|
|
175
|
my $oldline = $parser->{strmap}->{'__LINE__'}; |
4237
|
56
|
|
|
|
|
113
|
$parser->{strmap}->{'__LINE__'} = 1; |
4238
|
56
|
|
|
|
|
155
|
my $parser2 = $parser->subparser(); |
4239
|
56
|
|
|
|
|
170
|
my $ctx2 = $ctx->subctx(parser => $parser2, varhist => {}); |
4240
|
56
|
|
|
|
|
185
|
my $blk = $ctx2->parse_eval($args->[0]); |
4241
|
56
|
|
|
|
|
116
|
my $key; |
4242
|
56
|
100
|
|
|
|
160
|
if (defined $blk) { # might be non-string |
4243
|
48
|
|
|
|
|
182
|
$key = $ctx2->exec_eval($blk); |
4244
|
|
|
|
|
|
|
} |
4245
|
56
|
|
|
|
|
130
|
$parser->{strmap}->{'__LINE__'} = $oldline; |
4246
|
|
|
|
|
|
|
|
4247
|
56
|
100
|
|
|
|
146
|
if (defined $key) { |
4248
|
48
|
|
|
|
|
102
|
my $result = $parser->{strmap}->{$key}; |
4249
|
|
|
|
|
|
|
|
4250
|
|
|
|
|
|
|
# eval returns concatted list of statements (as example a single #str) |
4251
|
|
|
|
|
|
|
# |
4252
|
48
|
50
|
|
|
|
119
|
$ctx->{log}->($ctx, 'eval', $var, "%s(%s) -> %s", $cmd, $arglist->[0], $key) if $ctx->{log}; |
4253
|
|
|
|
|
|
|
|
4254
|
48
|
100
|
|
|
|
109
|
if (is_block($key)) { |
4255
|
13
|
|
|
|
|
40
|
my ($type, $a) = @{$parser->{strmap}->{$key}}; |
|
13
|
|
|
|
|
54
|
|
4256
|
13
|
|
|
|
|
44
|
register_funcs($a, $ctx, $parser); |
4257
|
|
|
|
|
|
|
} else { |
4258
|
35
|
|
|
|
|
139
|
register_funcs([$key], $ctx, $parser); |
4259
|
|
|
|
|
|
|
} |
4260
|
|
|
|
|
|
|
|
4261
|
48
|
|
|
|
|
128
|
my @seq = (); |
4262
|
48
|
|
|
|
|
170
|
$parser->flatten_block($key, \@seq); |
4263
|
48
|
|
|
|
|
162
|
my $r = _final_break($parser, $key, '(return)'); |
4264
|
48
|
100
|
|
|
|
116
|
if (defined $r) { |
4265
|
3
|
|
|
|
|
6
|
my $arg = $parser->{strmap}->{$r}->[1]; |
4266
|
|
|
|
|
|
|
|
4267
|
3
|
|
|
|
|
13
|
my $r2 = pop(@seq); # remove return statement from block |
4268
|
3
|
50
|
|
|
|
7
|
if ($r ne $r2) { |
4269
|
0
|
|
|
|
|
0
|
$ctx->{warn}->($ctx, 'eval', $var, "%s return mismatch $r != $r2", $parser->stmt_str($var)); |
4270
|
|
|
|
|
|
|
} |
4271
|
3
|
100
|
|
|
|
8
|
if (scalar @seq > 0) { |
4272
|
|
|
|
|
|
|
# insert simplified block without return here |
4273
|
1
|
|
|
|
|
7
|
my $b = $parser->setblk('flat', [@seq]); |
4274
|
1
|
|
|
|
|
10
|
my $v = '$eval$'.$var; |
4275
|
1
|
|
|
|
|
8
|
$ctx->track_assignment($v, $b); # track special $eval variable |
4276
|
1
|
50
|
|
|
|
6
|
$ctx->{log}->($ctx, 'eval', $var, "%s(%s) returns block %s [TRACK]", $cmd, $arglist->[0], $b) if $ctx->{log}; |
4277
|
|
|
|
|
|
|
} else { |
4278
|
2
|
50
|
|
|
|
6
|
$ctx->{log}->($ctx, 'eval', $var, "%s(%s) returns %s", $cmd, $arglist->[0], $r) if $ctx->{log}; |
4279
|
|
|
|
|
|
|
} |
4280
|
3
|
|
|
|
|
22
|
return $arg; |
4281
|
|
|
|
|
|
|
} |
4282
|
|
|
|
|
|
|
|
4283
|
|
|
|
|
|
|
# keep eval() around unresolved assignments for output |
4284
|
|
|
|
|
|
|
# (can't use $ctx->can_inline($key) here - local vars are valid). |
4285
|
|
|
|
|
|
|
# |
4286
|
45
|
|
|
|
|
141
|
my $resolved_eval = $ctx->can_inline_eval($key); |
4287
|
|
|
|
|
|
|
|
4288
|
45
|
50
|
33
|
|
|
132
|
if (!$resolved_eval && (scalar @seq == 1)) { |
4289
|
0
|
|
|
|
|
0
|
my $k = $parser->setcall('eval', [$key]); |
4290
|
0
|
0
|
|
|
|
0
|
$ctx->{log}->($ctx, 'eval', $var, "%s(%s) keep eval around return -> %s", $cmd, $arglist->[0], $key) if $ctx->{log}; |
4291
|
0
|
|
|
|
|
0
|
return $k; |
4292
|
|
|
|
|
|
|
} |
4293
|
|
|
|
|
|
|
|
4294
|
45
|
50
|
|
|
|
105
|
if ($key ne '#null') { |
4295
|
45
|
|
|
|
|
122
|
my $v = '$eval$x'.$var; |
4296
|
45
|
|
|
|
|
138
|
$ctx->track_assignment($v, $key); # track special $eval variable |
4297
|
45
|
50
|
|
|
|
110
|
$ctx->{log}->($ctx, 'eval', $var, "%s(%s) track last %s", $cmd, $arglist->[0], $key) if $ctx->{log}; |
4298
|
|
|
|
|
|
|
#$key = $parser->setblk('flat', []); |
4299
|
45
|
|
|
|
|
88
|
$key = '#null'; |
4300
|
|
|
|
|
|
|
} |
4301
|
45
|
|
|
|
|
304
|
return $key; |
4302
|
|
|
|
|
|
|
} |
4303
|
8
|
50
|
|
|
|
28
|
if (exists $ctx->{simplify}{call}) { |
4304
|
8
|
100
|
|
|
|
37
|
if ($args->[0] =~ /^#call\d+$/) { |
4305
|
|
|
|
|
|
|
# call without eval can not generate 'return ' |
4306
|
3
|
|
|
|
|
9
|
my $name = $parser->{strmap}->{$args->[0]}->[0]; |
4307
|
|
|
|
|
|
|
|
4308
|
3
|
100
|
|
|
|
12
|
if (!PHP::Decode::Func::func_may_return_string($name)) { |
4309
|
1
|
|
|
|
|
4
|
my $v = '$eval$x'.$var; |
4310
|
1
|
|
|
|
|
5
|
$ctx->track_assignment($v, $args->[0]); # track special $eval variable |
4311
|
1
|
50
|
|
|
|
4
|
$ctx->{log}->($ctx, 'eval', $var, "%s(%s) track call $args->[0]", $cmd, $arglist->[0]) if $ctx->{log}; |
4312
|
1
|
|
|
|
|
7
|
return '#null'; |
4313
|
|
|
|
|
|
|
} |
4314
|
|
|
|
|
|
|
} |
4315
|
|
|
|
|
|
|
} |
4316
|
7
|
|
|
|
|
23
|
$ctx->set_tainted($var); # eval() might always change variables |
4317
|
|
|
|
|
|
|
} elsif (($cmd eq 'assert') && (scalar @$arglist == 1)) { |
4318
|
4
|
|
|
|
|
28
|
my $val = $arglist->[0]; |
4319
|
4
|
|
|
|
|
16
|
my $key = $ctx->exec_statement($val); |
4320
|
|
|
|
|
|
|
|
4321
|
4
|
50
|
|
|
|
21
|
if (is_strval($key)) { |
4322
|
4
|
|
|
|
|
18
|
my $e = $parser->setcall('eval', [$val]); |
4323
|
4
|
|
|
|
|
13
|
$key = $ctx->exec_statement($e); |
4324
|
|
|
|
|
|
|
} |
4325
|
4
|
|
|
|
|
18
|
return $key; |
4326
|
|
|
|
|
|
|
} else { |
4327
|
468
|
100
|
|
|
|
1248
|
if ($cmd =~ /^\\(.*)$/) { |
4328
|
1
|
|
|
|
|
6
|
$cmd = $1; # remove absolute namespace |
4329
|
|
|
|
|
|
|
} |
4330
|
468
|
|
|
|
|
1423
|
my $f = PHP::Decode::Func::get_php_func($cmd); |
4331
|
|
|
|
|
|
|
|
4332
|
468
|
100
|
100
|
|
|
1727
|
if (defined $f && exists $f->{param}) { |
4333
|
24
|
|
|
|
|
73
|
($args, $arg_changed) = $ctx->resolve_arglist($arglist, $f->{param}, $in_block); |
4334
|
|
|
|
|
|
|
} else { |
4335
|
444
|
|
|
|
|
1333
|
($args, $arg_changed) = $ctx->resolve_arglist($arglist, [], $in_block); |
4336
|
|
|
|
|
|
|
} |
4337
|
468
|
|
|
|
|
1594
|
my $key = PHP::Decode::Func::exec_cmd($ctx, $cmd, $args); |
4338
|
468
|
100
|
|
|
|
987
|
if (defined $key) { |
4339
|
187
|
50
|
|
|
|
462
|
$ctx->{log}->($ctx, 'cmd', $var, "%s(%s) -> %s = %s", $cmd, join(' , ', @$args), $key, $parser->shortstr($parser->get_strval_or_str($key), 60)) if $ctx->{log}; |
4340
|
|
|
|
|
|
|
|
4341
|
187
|
100
|
|
|
|
446
|
if ($key eq '#noreturn') { |
4342
|
3
|
|
|
|
|
6
|
$key = $var; |
4343
|
3
|
50
|
33
|
|
|
17
|
if (($name ne $cmdsim) || $arg_changed) { |
4344
|
0
|
0
|
|
|
|
0
|
my @argssim = map { ($args->[$_] =~ /^(#inst\d+)$/) ? $arglist->[$_] : $args->[$_] } 0..$#$args; |
|
0
|
|
|
|
|
0
|
|
4345
|
0
|
|
|
|
|
0
|
$key = $parser->setcall($cmdsim, \@argssim); |
4346
|
0
|
0
|
|
|
|
0
|
$ctx->{log}->($ctx, 'cmd', $var, "simplify %s -> %s = %s(%s)", $parser->stmt_str($var), $key, $cmdsim, join(' , ', @argssim)) if $ctx->{log}; |
4347
|
|
|
|
|
|
|
} |
4348
|
|
|
|
|
|
|
} |
4349
|
187
|
|
|
|
|
700
|
return $key; |
4350
|
|
|
|
|
|
|
} |
4351
|
281
|
100
|
|
|
|
608
|
if (defined $f) { |
4352
|
55
|
100
|
|
|
|
196
|
if (exists $f->{param}) { |
4353
|
2
|
|
|
|
|
10
|
$ctx->invalidate_arglist_refs($arglist, $f->{param}, $in_block); |
4354
|
|
|
|
|
|
|
} |
4355
|
|
|
|
|
|
|
} else { |
4356
|
226
|
|
|
|
|
1208
|
$ctx->{warn}->($ctx, 'cmd', $var, "not found %s(%s)", $cmd, join(', ', @$arglist)); |
4357
|
|
|
|
|
|
|
} |
4358
|
281
|
100
|
|
|
|
18766
|
if (PHP::Decode::Func::func_may_call_callbacks($cmd)) { |
4359
|
229
|
|
|
|
|
816
|
$ctx->set_tainted($var); |
4360
|
|
|
|
|
|
|
} |
4361
|
|
|
|
|
|
|
} |
4362
|
|
|
|
|
|
|
# simplify function params for failed call |
4363
|
|
|
|
|
|
|
# |
4364
|
288
|
50
|
|
|
|
753
|
if (exists $ctx->{simplify}{call}) { |
4365
|
288
|
50
|
|
|
|
674
|
if (is_instvar($cmdsim)) { |
4366
|
0
|
|
|
|
|
0
|
$cmdsim = $name; |
4367
|
|
|
|
|
|
|
} |
4368
|
288
|
100
|
|
|
|
1023
|
my @argssim = map { ($args->[$_] =~ /^(#inst\d+)$/) ? $arglist->[$_] : $args->[$_] } 0..$#$args; |
|
161
|
|
|
|
|
852
|
|
4369
|
|
|
|
|
|
|
|
4370
|
288
|
100
|
100
|
|
|
1298
|
if (($name ne $cmdsim) || $arg_changed) { |
4371
|
69
|
|
|
|
|
305
|
my $k = $parser->setcall($cmdsim, \@argssim); |
4372
|
69
|
|
|
|
|
358
|
$ctx->{warn}->($ctx, 'exec', $var, "skip %s(%s) -> %s %s", $cmd, join(', ', @$arglist), $k, $parser->stmt_str($k)); |
4373
|
69
|
|
|
|
|
3809
|
return $k; |
4374
|
|
|
|
|
|
|
} |
4375
|
|
|
|
|
|
|
} |
4376
|
219
|
|
|
|
|
1099
|
$ctx->{warn}->($ctx, 'exec', $var, "skip %s(%s)", $cmd, join(', ', @$arglist)); |
4377
|
219
|
|
|
|
|
13832
|
return $var; |
4378
|
|
|
|
|
|
|
} elsif ($var =~ /^#blk\d+$/) { |
4379
|
1299
|
|
|
|
|
2088
|
my ($type, $arglist) = @{$parser->{strmap}->{$var}}; |
|
1299
|
|
|
|
|
3623
|
|
4380
|
1299
|
|
|
|
|
2528
|
my @args = (); |
4381
|
1299
|
|
|
|
|
2027
|
my $changed = 0; |
4382
|
1299
|
|
|
|
|
2458
|
foreach my $p (@$arglist) { |
4383
|
2138
|
|
|
|
|
3373
|
my $keep_assign = 0; |
4384
|
|
|
|
|
|
|
|
4385
|
2138
|
100
|
100
|
|
|
7490
|
if (($type ne 'brace') && ($type ne 'expr')) { |
4386
|
2018
|
|
|
|
|
3969
|
my ($rhs, $lhs) = _var_assignment($parser, $p); |
4387
|
2018
|
100
|
100
|
|
|
5411
|
if (defined $rhs || _is_increment_op($parser, $p)) { |
4388
|
810
|
50
|
|
|
|
1804
|
$ctx->{log}->($ctx, 'exec', $var, "keep assignment $p intact -> set in_block") if $ctx->{log}; |
4389
|
810
|
|
|
|
|
1526
|
$keep_assign = 1; |
4390
|
|
|
|
|
|
|
} |
4391
|
|
|
|
|
|
|
} |
4392
|
2138
|
100
|
|
|
|
6221
|
my $v = $ctx->exec_statement($p, $keep_assign ? 1 : $in_block); |
4393
|
2138
|
50
|
|
|
|
4767
|
unless (defined $v) { |
4394
|
0
|
|
|
|
|
0
|
last; |
4395
|
|
|
|
|
|
|
} |
4396
|
|
|
|
|
|
|
|
4397
|
|
|
|
|
|
|
# insert assignments only in code blocks. Assigments |
4398
|
|
|
|
|
|
|
# in expressions are inserted into the next outer block. |
4399
|
|
|
|
|
|
|
# |
4400
|
2138
|
100
|
100
|
|
|
6937
|
if (($type ne 'brace') && ($type ne 'expr')) { |
4401
|
2018
|
|
|
|
|
4908
|
my $v1 = $ctx->insert_assignments($v); |
4402
|
2018
|
100
|
|
|
|
4261
|
if ($v1 ne $v) { |
4403
|
141
|
50
|
|
|
|
459
|
if (exists $ctx->{with}{optimize_block_vars}) { |
4404
|
0
|
|
|
|
|
0
|
my @seq = (); |
4405
|
0
|
|
|
|
|
0
|
$parser->flatten_block($v1, \@seq); |
4406
|
0
|
|
|
|
|
0
|
$ctx->optimize_loop_var_list('exec', $var, \@args, \@seq); |
4407
|
|
|
|
|
|
|
} else { |
4408
|
141
|
|
|
|
|
372
|
$parser->flatten_block($v1, \@args); |
4409
|
|
|
|
|
|
|
} |
4410
|
141
|
|
|
|
|
284
|
$changed = 1; |
4411
|
|
|
|
|
|
|
} else { |
4412
|
1877
|
|
|
|
|
5212
|
$parser->flatten_block($v, \@args); |
4413
|
|
|
|
|
|
|
} |
4414
|
|
|
|
|
|
|
} else { |
4415
|
120
|
|
|
|
|
391
|
$parser->flatten_block($v, \@args); |
4416
|
|
|
|
|
|
|
} |
4417
|
2138
|
100
|
|
|
|
4275
|
if ($p ne $v) { |
4418
|
1027
|
|
|
|
|
1641
|
$changed = 1; |
4419
|
|
|
|
|
|
|
} |
4420
|
2138
|
|
|
|
|
4315
|
my $f = _final_break($parser, $v, '(break|continue|return)'); |
4421
|
2138
|
100
|
|
|
|
5317
|
if (defined $f) { |
4422
|
256
|
100
|
|
|
|
658
|
if (scalar @args < scalar @$arglist) { |
4423
|
9
|
|
|
|
|
19
|
$changed = 1; |
4424
|
|
|
|
|
|
|
} |
4425
|
256
|
|
|
|
|
539
|
last; |
4426
|
|
|
|
|
|
|
} |
4427
|
|
|
|
|
|
|
} |
4428
|
|
|
|
|
|
|
# evaluate block to string or anonymous func if possible |
4429
|
|
|
|
|
|
|
# |
4430
|
1299
|
100
|
100
|
|
|
4187
|
if (scalar @args == 1 && (is_strval($args[0]) || ($args[0] =~ /^#fun\d+$/))) { |
|
|
|
100
|
|
|
|
|
4431
|
92
|
50
|
|
|
|
290
|
$ctx->{log}->($ctx, 'exec', $var, "reduce: $arglist->[0] -> $args[0]") if $ctx->{log}; |
4432
|
92
|
|
|
|
|
259
|
return $args[0]; |
4433
|
|
|
|
|
|
|
} |
4434
|
1207
|
100
|
|
|
|
2496
|
if ($changed) { |
4435
|
743
|
|
|
|
|
1854
|
$var = $parser->setblk($type, \@args); |
4436
|
|
|
|
|
|
|
} |
4437
|
1207
|
|
|
|
|
3825
|
return $var; |
4438
|
|
|
|
|
|
|
} elsif ($var =~ /^#stmt\d+$/) { |
4439
|
710
|
|
|
|
|
1919
|
my $cmd = $parser->{strmap}->{$var}->[0]; |
4440
|
|
|
|
|
|
|
|
4441
|
710
|
100
|
|
|
|
4530
|
if ($cmd eq 'echo') { |
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
4442
|
184
|
|
|
|
|
380
|
my $arglist = $parser->{strmap}->{$var}->[1]; |
4443
|
184
|
|
|
|
|
379
|
my @param = (); |
4444
|
184
|
|
|
|
|
296
|
my $all_str = 1; |
4445
|
184
|
|
|
|
|
290
|
my $changed = 0; |
4446
|
|
|
|
|
|
|
|
4447
|
184
|
|
|
|
|
381
|
foreach my $p (@$arglist) { |
4448
|
193
|
100
|
100
|
|
|
389
|
if (!is_strval($p) || is_const($p)) { |
4449
|
107
|
|
|
|
|
459
|
my $v = $ctx->exec_statement($p); |
4450
|
107
|
|
|
|
|
290
|
push(@param, $v); |
4451
|
107
|
100
|
|
|
|
264
|
if ($v ne $p) { |
4452
|
88
|
|
|
|
|
181
|
$changed = 1; |
4453
|
|
|
|
|
|
|
} |
4454
|
107
|
100
|
|
|
|
249
|
unless (is_strval($v)) { |
4455
|
31
|
|
|
|
|
119
|
$all_str = 0; |
4456
|
|
|
|
|
|
|
} |
4457
|
|
|
|
|
|
|
} else { |
4458
|
86
|
|
|
|
|
270
|
push(@param, $p); |
4459
|
|
|
|
|
|
|
} |
4460
|
|
|
|
|
|
|
} |
4461
|
|
|
|
|
|
|
# keep consts in simplified statement |
4462
|
|
|
|
|
|
|
# |
4463
|
184
|
100
|
100
|
|
|
542
|
my @paramsim = map { (is_const($arglist->[$_]) && !$parser->is_magic_const($arglist->[$_]) && !exists $ctx->{defines}{$parser->{strmap}{$arglist->[$_]}}) ? $arglist->[$_] : $param[$_] } 0..$#param; |
|
193
|
|
|
|
|
499
|
|
4464
|
|
|
|
|
|
|
|
4465
|
184
|
|
|
|
|
481
|
my $v = $parser->{strmap}->{$var}; |
4466
|
|
|
|
|
|
|
|
4467
|
|
|
|
|
|
|
# echo echoes also non-quoted arguments (undefined constants propagate to string) |
4468
|
|
|
|
|
|
|
# (keep them separated here if not all arguments could get resolved) |
4469
|
|
|
|
|
|
|
# |
4470
|
184
|
100
|
100
|
|
|
743
|
if ($all_str && (scalar @param > 1)) { |
4471
|
4
|
|
|
|
|
30
|
my $res = join('', map { $parser->{strmap}->{$_} } @param); |
|
12
|
|
|
|
|
37
|
|
4472
|
4
|
|
|
|
|
25
|
my $k = $parser->setstr($res); |
4473
|
4
|
|
|
|
|
28
|
@param = ($k); |
4474
|
4
|
|
|
|
|
10
|
$changed = 1; |
4475
|
|
|
|
|
|
|
} |
4476
|
184
|
100
|
|
|
|
496
|
unless ($ctx->{skipundef}) { |
4477
|
119
|
100
|
66
|
|
|
540
|
if (exists $ctx->{globals} && exists $ctx->{globals}{stdout}) { |
4478
|
117
|
100
|
|
|
|
309
|
if (exists $ctx->{globals}{stdout}{ob}) { |
4479
|
1
|
|
|
|
|
2
|
push(@{$ctx->{globals}{stdout}{ob}}, @param); |
|
1
|
|
|
|
|
13
|
|
4480
|
|
|
|
|
|
|
} else { |
4481
|
116
|
|
|
|
|
196
|
push(@{$ctx->{globals}{stdout}{buf}}, @param); |
|
116
|
|
|
|
|
426
|
|
4482
|
|
|
|
|
|
|
} |
4483
|
|
|
|
|
|
|
} |
4484
|
|
|
|
|
|
|
} |
4485
|
184
|
50
|
|
|
|
453
|
if (exists $ctx->{simplify}{stmt}) { |
4486
|
184
|
100
|
|
|
|
367
|
if ($changed) { |
4487
|
84
|
100
|
|
|
|
217
|
if (scalar @paramsim > 1) { |
4488
|
5
|
|
|
|
|
22
|
merge_str_list(\@paramsim, $parser); |
4489
|
|
|
|
|
|
|
} |
4490
|
84
|
|
|
|
|
330
|
my $k = $parser->setstmt(['echo', \@paramsim]); |
4491
|
84
|
50
|
|
|
|
238
|
$ctx->{log}->($ctx, 'echo', $var, "simplify -> $k") if $ctx->{log}; |
4492
|
84
|
|
|
|
|
272
|
return $k; |
4493
|
|
|
|
|
|
|
} |
4494
|
|
|
|
|
|
|
} |
4495
|
100
|
|
|
|
|
319
|
return $var; |
4496
|
|
|
|
|
|
|
} elsif ($cmd eq 'print') { |
4497
|
0
|
|
|
|
|
0
|
my $arg = $parser->{strmap}->{$var}->[1]; |
4498
|
0
|
|
|
|
|
0
|
my $v = $ctx->exec_statement($arg); |
4499
|
|
|
|
|
|
|
|
4500
|
0
|
0
|
|
|
|
0
|
unless ($ctx->{skipundef}) { |
4501
|
0
|
0
|
0
|
|
|
0
|
if (exists $ctx->{globals} && exists $ctx->{globals}{stdout}) { |
4502
|
0
|
0
|
|
|
|
0
|
if (exists $ctx->{globals}{stdout}{ob}) { |
4503
|
0
|
|
|
|
|
0
|
push(@{$ctx->{globals}{stdout}{ob}}, $v); |
|
0
|
|
|
|
|
0
|
|
4504
|
|
|
|
|
|
|
} else { |
4505
|
0
|
|
|
|
|
0
|
push(@{$ctx->{globals}{stdout}{buf}}, $v); |
|
0
|
|
|
|
|
0
|
|
4506
|
|
|
|
|
|
|
} |
4507
|
|
|
|
|
|
|
} |
4508
|
|
|
|
|
|
|
} |
4509
|
0
|
0
|
|
|
|
0
|
if (exists $ctx->{simplify}{stmt}) { |
4510
|
0
|
0
|
|
|
|
0
|
if ($v ne $arg) { |
4511
|
0
|
|
|
|
|
0
|
my $k = $parser->setstmt(['print', $v]); |
4512
|
0
|
0
|
|
|
|
0
|
$ctx->{log}->($ctx, 'print', $var, "simplify -> $k") if $ctx->{log}; |
4513
|
0
|
|
|
|
|
0
|
return $k; |
4514
|
|
|
|
|
|
|
} |
4515
|
|
|
|
|
|
|
} |
4516
|
0
|
|
|
|
|
0
|
return $var; |
4517
|
|
|
|
|
|
|
} elsif ($cmd eq 'global') { |
4518
|
10
|
|
|
|
|
45
|
my $arglist = $parser->{strmap}->{$var}->[1]; |
4519
|
10
|
|
|
|
|
23
|
my @param = (); |
4520
|
|
|
|
|
|
|
|
4521
|
10
|
|
|
|
|
25
|
foreach my $v (@$arglist) { |
4522
|
10
|
50
|
|
|
|
25
|
if (is_variable($v)) { |
4523
|
10
|
50
|
|
|
|
30
|
if ($ctx->is_superglobal($v)) { |
4524
|
0
|
0
|
|
|
|
0
|
$ctx->{log}->($ctx, 'global', $var, "ignore global superglobal $v") if $ctx->{log}; |
4525
|
|
|
|
|
|
|
} else { |
4526
|
10
|
|
|
|
|
36
|
$ctx->{varmap}{global}{$v} = 1; |
4527
|
10
|
50
|
|
|
|
36
|
$ctx->{log}->($ctx, 'global', $var, "set func var $v global") if $ctx->{log}; |
4528
|
|
|
|
|
|
|
} |
4529
|
|
|
|
|
|
|
} |
4530
|
|
|
|
|
|
|
} |
4531
|
10
|
|
|
|
|
27
|
return $var; |
4532
|
|
|
|
|
|
|
} elsif ($cmd eq 'static') { |
4533
|
15
|
|
|
|
|
35
|
my $arglist = $parser->{strmap}->{$var}->[1]; |
4534
|
15
|
|
|
|
|
28
|
my @param = (); |
4535
|
|
|
|
|
|
|
|
4536
|
15
|
|
|
|
|
36
|
foreach my $v (@$arglist) { |
4537
|
15
|
100
|
|
|
|
62
|
if (is_variable($v)) { |
|
|
50
|
|
|
|
|
|
4538
|
10
|
50
|
|
|
|
66
|
if ($ctx->is_superglobal($v)) { |
4539
|
0
|
0
|
|
|
|
0
|
$ctx->{log}->($ctx, 'static', $var, "ignore static superglobal $v") if $ctx->{log}; |
4540
|
|
|
|
|
|
|
} else { |
4541
|
10
|
100
|
|
|
|
52
|
if ($ctx->{infunction}) { |
|
|
50
|
|
|
|
|
|
4542
|
3
|
100
|
|
|
|
16
|
unless (exists $ctx->{varmap}{static}{$ctx->{infunction}}{$v}) { |
4543
|
1
|
|
|
|
|
4
|
$ctx->{varmap}{static}{$ctx->{infunction}}{$v} = undef; |
4544
|
1
|
50
|
|
|
|
4
|
$ctx->{log}->($ctx, 'static', $var, "set static func var $v") if $ctx->{log}; |
4545
|
|
|
|
|
|
|
} |
4546
|
|
|
|
|
|
|
} elsif (exists $ctx->{class_scope}) { |
4547
|
7
|
50
|
|
|
|
29
|
unless (exists $ctx->{varmap}{inst}{$ctx->{class_scope}}{$v}) { |
4548
|
7
|
|
|
|
|
22
|
$ctx->{varmap}{inst}{$ctx->{class_scope}}{$v} = undef; |
4549
|
7
|
50
|
|
|
|
27
|
$ctx->{log}->($ctx, 'static', $var, "set static class var $v") if $ctx->{log}; |
4550
|
|
|
|
|
|
|
} |
4551
|
|
|
|
|
|
|
} else { |
4552
|
0
|
0
|
|
|
|
0
|
$ctx->{log}->($ctx, 'static', $var, "ignore toplevel static var $v") if $ctx->{log}; |
4553
|
|
|
|
|
|
|
} |
4554
|
|
|
|
|
|
|
} |
4555
|
|
|
|
|
|
|
} elsif ($v =~ /^#expr\d+$/) { |
4556
|
5
|
|
|
|
|
11
|
my ($op, $v1, $v2) = @{$parser->{strmap}->{$v}}; |
|
5
|
|
|
|
|
14
|
|
4557
|
5
|
50
|
|
|
|
14
|
if ($op eq '=') { |
4558
|
5
|
50
|
|
|
|
17
|
if ($ctx->is_superglobal($v1)) { |
4559
|
0
|
0
|
|
|
|
0
|
$ctx->{log}->($ctx, 'static', $var, "ignore static superglobal $v1") if $ctx->{log}; |
4560
|
|
|
|
|
|
|
} else { |
4561
|
5
|
100
|
|
|
|
19
|
if ($ctx->{infunction}) { |
|
|
50
|
|
|
|
|
|
4562
|
3
|
100
|
|
|
|
14
|
unless (exists $ctx->{varmap}{static}{$ctx->{infunction}}{$v1}) { |
4563
|
1
|
|
|
|
|
4
|
$ctx->{varmap}{static}{$ctx->{infunction}}{$v1} = $v2; |
4564
|
1
|
50
|
|
|
|
6
|
$ctx->{log}->($ctx, 'static', $var, "set static func var $v1 = $v2") if $ctx->{log}; |
4565
|
|
|
|
|
|
|
} |
4566
|
|
|
|
|
|
|
} elsif (exists $ctx->{class_scope}) { |
4567
|
2
|
50
|
|
|
|
10
|
unless (exists $ctx->{varmap}{inst}{$ctx->{class_scope}}{$v1}) { |
4568
|
2
|
|
|
|
|
6
|
$ctx->{varmap}{inst}{$ctx->{class_scope}}{$v1} = $v2; |
4569
|
2
|
50
|
|
|
|
8
|
$ctx->{log}->($ctx, 'static', $var, "set static class var $v1 = $v2") if $ctx->{log}; |
4570
|
|
|
|
|
|
|
} |
4571
|
|
|
|
|
|
|
} else { |
4572
|
0
|
0
|
|
|
|
0
|
$ctx->{log}->($ctx, 'static', $var, "ignore toplevel static var $v1") if $ctx->{log}; |
4573
|
|
|
|
|
|
|
} |
4574
|
|
|
|
|
|
|
} |
4575
|
|
|
|
|
|
|
} else { |
4576
|
0
|
|
|
|
|
0
|
$ctx->{warn}->($ctx, 'static', $var, "bad init $v"); |
4577
|
|
|
|
|
|
|
} |
4578
|
|
|
|
|
|
|
} else { |
4579
|
0
|
|
|
|
|
0
|
my $k = $ctx->exec_statement($v, 1); |
4580
|
|
|
|
|
|
|
} |
4581
|
|
|
|
|
|
|
} |
4582
|
15
|
|
|
|
|
46
|
return $var; |
4583
|
|
|
|
|
|
|
} elsif ($cmd eq 'const') { |
4584
|
9
|
|
|
|
|
36
|
my $arglist = $parser->{strmap}->{$var}->[1]; |
4585
|
9
|
|
|
|
|
20
|
my @param = (); |
4586
|
|
|
|
|
|
|
|
4587
|
9
|
|
|
|
|
23
|
foreach my $v (@$arglist) { |
4588
|
9
|
50
|
|
|
|
35
|
if ($v =~ /^#expr\d+$/) { |
4589
|
9
|
|
|
|
|
13
|
my ($op, $v1, $v2) = @{$parser->{strmap}->{$v}}; |
|
9
|
|
|
|
|
33
|
|
4590
|
|
|
|
|
|
|
|
4591
|
9
|
50
|
|
|
|
27
|
if ($op eq '=') { |
4592
|
9
|
50
|
|
|
|
33
|
unless (is_const($v1)) { |
|
|
50
|
|
|
|
|
|
4593
|
0
|
0
|
|
|
|
0
|
$ctx->{warn}->($ctx, 'const', $var, "ignore non-const const $v1") if $ctx->{log}; |
4594
|
0
|
|
|
|
|
0
|
} elsif ($ctx->{infunction}) { |
4595
|
0
|
0
|
|
|
|
0
|
$ctx->{warn}->($ctx, 'const', $var, "ignore in-function const $v1") if $ctx->{log}; |
4596
|
|
|
|
|
|
|
} else { |
4597
|
9
|
|
|
|
|
22
|
my $name = $parser->{strmap}{$v1}; # consts are case-sensitive |
4598
|
9
|
|
|
|
|
20
|
my $op2 = $ctx->exec_statement($v2, 1); # should be constant expression |
4599
|
|
|
|
|
|
|
|
4600
|
9
|
100
|
|
|
|
56
|
if (exists $ctx->{class_scope}) { |
4601
|
4
|
|
|
|
|
23
|
$name = method_name($ctx->{class_scope}, $name); |
4602
|
|
|
|
|
|
|
} |
4603
|
9
|
100
|
|
|
|
25
|
if ($ctx->{namespace}) { |
4604
|
4
|
|
|
|
|
20
|
$name = ns_name(lc($ctx->{namespace}), $name); |
4605
|
|
|
|
|
|
|
} |
4606
|
9
|
|
|
|
|
49
|
$ctx->{defines}{$name} = $op2; |
4607
|
9
|
50
|
|
|
|
37
|
$ctx->{log}->($ctx, 'const', $var, "set const $name = $op2") if $ctx->{log}; |
4608
|
|
|
|
|
|
|
} |
4609
|
|
|
|
|
|
|
} else { |
4610
|
0
|
|
|
|
|
0
|
$ctx->{warn}->($ctx, 'const', $var, "bad const expr $v"); |
4611
|
|
|
|
|
|
|
} |
4612
|
|
|
|
|
|
|
} else { |
4613
|
0
|
|
|
|
|
0
|
$ctx->{warn}->($ctx, 'const', $var, "bad const statement $v"); |
4614
|
|
|
|
|
|
|
} |
4615
|
|
|
|
|
|
|
} |
4616
|
9
|
|
|
|
|
27
|
return $var; |
4617
|
|
|
|
|
|
|
} elsif ($cmd eq 'return') { |
4618
|
254
|
|
|
|
|
586
|
my $arg = $parser->{strmap}->{$var}->[1]; |
4619
|
254
|
|
|
|
|
576
|
my $res = $ctx->exec_statement($arg); |
4620
|
254
|
100
|
66
|
|
|
1087
|
if (defined $res && ($arg ne $res)) { |
4621
|
107
|
|
|
|
|
439
|
my $k = $parser->setstmt(['return', $res]); |
4622
|
107
|
|
|
|
|
334
|
return $k; |
4623
|
|
|
|
|
|
|
} |
4624
|
147
|
|
|
|
|
381
|
return $var; |
4625
|
|
|
|
|
|
|
} elsif ($cmd eq 'unset') { |
4626
|
|
|
|
|
|
|
# https://www.php.net/manual/en/function.unset.php |
4627
|
|
|
|
|
|
|
# |
4628
|
5
|
|
|
|
|
11
|
my $arglist = $parser->{strmap}->{$var}->[1]; |
4629
|
5
|
|
|
|
|
12
|
my @param = (); |
4630
|
5
|
|
|
|
|
7
|
my $all_var = 1; |
4631
|
5
|
|
|
|
|
10
|
my $changed = 0; |
4632
|
|
|
|
|
|
|
|
4633
|
5
|
|
|
|
|
12
|
foreach my $p (@$arglist) { |
4634
|
5
|
100
|
|
|
|
12
|
if (is_variable($p)) { |
|
|
50
|
|
|
|
|
|
4635
|
1
|
50
|
|
|
|
5
|
if (exists $ctx->{varmap}{$p}) { |
4636
|
1
|
50
|
|
|
|
5
|
$ctx->{log}->($ctx, 'unset', $var, "unset $p") if $ctx->{log}; |
4637
|
|
|
|
|
|
|
} else { |
4638
|
0
|
0
|
|
|
|
0
|
$ctx->{log}->($ctx, 'unset', $var, "unset undefined $p") if $ctx->{log}; |
4639
|
|
|
|
|
|
|
} |
4640
|
1
|
|
|
|
|
5
|
$ctx->setvar($p, '#null', 1); |
4641
|
1
|
|
|
|
|
3
|
push(@param, $p); |
4642
|
1
|
|
|
|
|
3
|
next; |
4643
|
|
|
|
|
|
|
} elsif ($p =~ /^(\#elem\d+)$/) { |
4644
|
|
|
|
|
|
|
# todo: suppport multi dimensional |
4645
|
|
|
|
|
|
|
# |
4646
|
4
|
|
|
|
|
9
|
my ($v, $i) = @{$parser->{strmap}->{$p}}; |
|
4
|
|
|
|
|
13
|
|
4647
|
4
|
|
|
|
|
13
|
my ($basevar, $has_index, $idxstr) = $ctx->resolve_variable($p, 0); |
4648
|
4
|
50
|
|
|
|
13
|
if (defined $basevar) { |
4649
|
4
|
100
|
|
|
|
9
|
if ($has_index) { |
4650
|
3
|
|
|
|
|
10
|
my $basestr = $ctx->exec_statement($basevar, 0); |
4651
|
3
|
100
|
66
|
|
|
17
|
if (defined $basestr && is_array($basestr) && defined $idxstr) { |
|
|
|
66
|
|
|
|
|
4652
|
2
|
|
|
|
|
5
|
my $arr = $parser->{strmap}->{$basestr}; |
4653
|
2
|
50
|
|
|
|
10
|
$idxstr = $parser->setstr('') if is_null($idxstr); # null maps to '' array index |
4654
|
2
|
|
|
|
|
16
|
my $arrval = $arr->get($idxstr); |
4655
|
2
|
50
|
|
|
|
8
|
if (defined $arrval) { |
4656
|
2
|
|
|
|
|
5
|
my $idxval = $arr->get_index($idxstr); |
4657
|
2
|
50
|
|
|
|
8
|
$ctx->{log}->($ctx, 'unset', $var, "unset elem $p: %s %s[%s]", $basevar, $basestr, $idxstr) if $ctx->{log}; |
4658
|
2
|
|
|
|
|
7
|
my $arr2 = $arr->copy(); |
4659
|
2
|
|
|
|
|
18
|
$arr2->delete($idxval); |
4660
|
2
|
|
|
|
|
60
|
$ctx->setvar($basevar, $arr2->{name}, 1); |
4661
|
|
|
|
|
|
|
} |
4662
|
|
|
|
|
|
|
} else { |
4663
|
1
|
50
|
|
|
|
6
|
$ctx->{log}->($ctx, 'unset', $var, "unset undefined elem $p") if $ctx->{log}; |
4664
|
|
|
|
|
|
|
} |
4665
|
|
|
|
|
|
|
} else { |
4666
|
1
|
50
|
|
|
|
4
|
if (exists $ctx->{varmap}{$basevar}) { |
4667
|
0
|
0
|
|
|
|
0
|
$ctx->{log}->($ctx, 'unset', $var, "unset global $p: $basevar") if $ctx->{log}; |
4668
|
|
|
|
|
|
|
} else { |
4669
|
1
|
50
|
|
|
|
4
|
$ctx->{log}->($ctx, 'unset', $var, "unset undefined global $p: $basevar") if $ctx->{log}; |
4670
|
|
|
|
|
|
|
} |
4671
|
1
|
|
|
|
|
4
|
$ctx->setvar($basevar, '#null', 1); |
4672
|
1
|
|
|
|
|
3
|
push(@param, $basevar); |
4673
|
1
|
|
|
|
|
2
|
$changed = 1; |
4674
|
1
|
|
|
|
|
3
|
next; |
4675
|
|
|
|
|
|
|
} |
4676
|
|
|
|
|
|
|
} |
4677
|
|
|
|
|
|
|
} else { |
4678
|
0
|
|
|
|
|
0
|
$ctx->{warn}->($ctx, 'unset', $var, "$p not found"); |
4679
|
|
|
|
|
|
|
} |
4680
|
3
|
|
|
|
|
11
|
my $v = $ctx->exec_statement($p); |
4681
|
3
|
|
|
|
|
5
|
push(@param, $v); |
4682
|
3
|
100
|
|
|
|
9
|
if ($v ne $p) { |
4683
|
1
|
|
|
|
|
3
|
$changed = 1; |
4684
|
|
|
|
|
|
|
} |
4685
|
3
|
|
|
|
|
7
|
$all_var = 0; |
4686
|
|
|
|
|
|
|
} |
4687
|
|
|
|
|
|
|
#unless ($all_var) { |
4688
|
|
|
|
|
|
|
# $ctx->set_tainted($var); |
4689
|
|
|
|
|
|
|
#} |
4690
|
5
|
50
|
|
|
|
14
|
if (exists $ctx->{simplify}{stmt}) { |
4691
|
5
|
100
|
|
|
|
12
|
if ($changed) { |
4692
|
2
|
|
|
|
|
9
|
my $k = $parser->setstmt(['unset', \@param]); |
4693
|
2
|
50
|
|
|
|
19
|
$ctx->{log}->($ctx, 'unset', $var, "simplify -> $k") if $ctx->{log}; |
4694
|
2
|
|
|
|
|
9
|
return $k; |
4695
|
|
|
|
|
|
|
} |
4696
|
|
|
|
|
|
|
} |
4697
|
3
|
|
|
|
|
10
|
return $var; |
4698
|
|
|
|
|
|
|
} elsif ($cmd eq 'break') { |
4699
|
2
|
|
|
|
|
7
|
return $var; |
4700
|
|
|
|
|
|
|
} elsif ($cmd eq 'continue') { |
4701
|
0
|
|
|
|
|
0
|
return $var; |
4702
|
|
|
|
|
|
|
} elsif ($cmd eq 'namespace') { |
4703
|
10
|
|
|
|
|
16
|
my ($arg, $block) = @{$parser->{strmap}->{$var}}[1..2]; |
|
10
|
|
|
|
|
27
|
|
4704
|
|
|
|
|
|
|
|
4705
|
10
|
|
|
|
|
42
|
$ctx->{namespace} = $arg; # always use case in-sensitive later |
4706
|
|
|
|
|
|
|
|
4707
|
10
|
100
|
|
|
|
24
|
if (defined $block) { |
4708
|
2
|
|
|
|
|
18
|
my $block1 = $ctx->exec_statement($block); |
4709
|
2
|
100
|
|
|
|
10
|
if ($block1 ne $block) { |
4710
|
1
|
|
|
|
|
28
|
my $k = $parser->setstmt(['namespace', $arg, $block1]); |
4711
|
1
|
|
|
|
|
7
|
return $k; |
4712
|
|
|
|
|
|
|
} |
4713
|
|
|
|
|
|
|
} |
4714
|
9
|
|
|
|
|
25
|
return $var; |
4715
|
|
|
|
|
|
|
} elsif ($cmd =~ /^(include|include_once|require|require_once)$/) { |
4716
|
0
|
|
|
|
|
0
|
my $arg = $parser->{strmap}->{$var}->[1]; |
4717
|
0
|
|
|
|
|
0
|
my $v = $ctx->exec_statement($arg); |
4718
|
|
|
|
|
|
|
|
4719
|
0
|
|
|
|
|
0
|
$ctx->set_tainted($var); |
4720
|
|
|
|
|
|
|
|
4721
|
0
|
0
|
|
|
|
0
|
if (exists $ctx->{simplify}{stmt}) { |
4722
|
0
|
0
|
|
|
|
0
|
if ($v ne $arg) { |
4723
|
0
|
|
|
|
|
0
|
my $k = $parser->setstmt([$cmd, $v]); |
4724
|
0
|
0
|
|
|
|
0
|
$ctx->{log}->($ctx, $cmd, $var, "simplify -> $k") if $ctx->{log}; |
4725
|
0
|
|
|
|
|
0
|
return $k; |
4726
|
|
|
|
|
|
|
} |
4727
|
|
|
|
|
|
|
} |
4728
|
0
|
|
|
|
|
0
|
return $var; |
4729
|
|
|
|
|
|
|
} elsif ($cmd eq 'if') { |
4730
|
150
|
|
|
|
|
267
|
my ($expr, $then, $else) = @{$parser->{strmap}->{$var}}[1..3]; |
|
150
|
|
|
|
|
611
|
|
4731
|
|
|
|
|
|
|
|
4732
|
150
|
|
|
|
|
441
|
my $cond = $ctx->exec_statement($expr); |
4733
|
|
|
|
|
|
|
|
4734
|
|
|
|
|
|
|
# insert possible assignment from expr |
4735
|
|
|
|
|
|
|
# |
4736
|
150
|
|
|
|
|
460
|
my $fin = $ctx->insert_assignments(undef); |
4737
|
|
|
|
|
|
|
|
4738
|
150
|
0
|
|
|
|
438
|
$ctx->{log}->($ctx, 'if', $var, "expr %s -> %s", $expr, defined $cond ? $cond : '') if $ctx->{log}; |
|
|
50
|
|
|
|
|
|
4739
|
150
|
100
|
100
|
|
|
601
|
if (defined $cond && (is_strval($cond) || is_array($cond))) { |
|
|
|
66
|
|
|
|
|
4740
|
48
|
|
|
|
|
112
|
my $res; |
4741
|
|
|
|
|
|
|
|
4742
|
48
|
|
|
|
|
137
|
my $val = $parser->{strmap}{$cond}; |
4743
|
48
|
100
|
|
|
|
126
|
if (is_array($cond)) { |
4744
|
1
|
|
|
|
|
3
|
my $arr = $parser->{strmap}{$cond}; |
4745
|
1
|
|
|
|
|
6
|
$val = !$arr->empty(); |
4746
|
|
|
|
|
|
|
} |
4747
|
48
|
100
|
|
|
|
153
|
if ($val) { |
|
|
100
|
|
|
|
|
|
4748
|
25
|
|
|
|
|
67
|
$res = $ctx->exec_statement($then); |
4749
|
25
|
|
|
|
|
109
|
$res = $parser->flatten_block_if_single($res); |
4750
|
|
|
|
|
|
|
} elsif (defined $else) { |
4751
|
11
|
|
|
|
|
35
|
$res = $ctx->exec_statement($else); |
4752
|
11
|
|
|
|
|
38
|
$res = $parser->flatten_block_if_single($res); |
4753
|
|
|
|
|
|
|
} else { |
4754
|
12
|
|
|
|
|
45
|
$res = $parser->setblk('flat', []); |
4755
|
|
|
|
|
|
|
} |
4756
|
|
|
|
|
|
|
|
4757
|
|
|
|
|
|
|
# convert std blocks to flat |
4758
|
|
|
|
|
|
|
# |
4759
|
48
|
|
|
|
|
135
|
my @seq = (); |
4760
|
48
|
100
|
|
|
|
210
|
$parser->flatten_block($fin, \@seq) if defined $fin; |
4761
|
48
|
|
|
|
|
210
|
$parser->flatten_block($res, \@seq); |
4762
|
48
|
100
|
|
|
|
288
|
if (scalar @seq > 1) { |
|
|
100
|
|
|
|
|
|
4763
|
4
|
|
|
|
|
22
|
$res = $parser->setblk('flat', [@seq]); |
4764
|
|
|
|
|
|
|
} elsif (scalar @seq > 0) { |
4765
|
32
|
|
|
|
|
69
|
$res = $seq[0]; |
4766
|
|
|
|
|
|
|
} |
4767
|
48
|
|
|
|
|
155
|
return $res; |
4768
|
|
|
|
|
|
|
} |
4769
|
|
|
|
|
|
|
|
4770
|
|
|
|
|
|
|
# simplify if |
4771
|
|
|
|
|
|
|
# |
4772
|
|
|
|
|
|
|
# invalidate undefined variables first to avoid '#null' compares |
4773
|
|
|
|
|
|
|
# |
4774
|
102
|
|
|
|
|
240
|
my $var0 = $var; |
4775
|
102
|
100
|
|
|
|
270
|
if ($expr ne $cond) { |
4776
|
|
|
|
|
|
|
# use cond with removed assignments |
4777
|
44
|
|
|
|
|
188
|
$var0 = $parser->setstmt(['if', $cond, $then, $else]); |
4778
|
|
|
|
|
|
|
} |
4779
|
102
|
|
|
|
|
328
|
my $info = $ctx->get_unresolved_info($var, $var0); |
4780
|
102
|
|
|
|
|
425
|
$ctx->invalidate_undefined_vars($info, 'if', $var); |
4781
|
|
|
|
|
|
|
|
4782
|
|
|
|
|
|
|
# run with unresolved vars to simplify then/else and |
4783
|
|
|
|
|
|
|
# unresolve changed variables afterwards again. |
4784
|
|
|
|
|
|
|
# |
4785
|
102
|
|
|
|
|
354
|
my $ctx_t = $ctx->clone(); |
4786
|
102
|
|
|
|
|
177
|
my $ctx_e; |
4787
|
102
|
|
|
|
|
285
|
my $then1 = $ctx_t->exec_statement($then); |
4788
|
102
|
|
|
|
|
235
|
my $else1; |
4789
|
102
|
100
|
|
|
|
302
|
if (defined $else) { |
4790
|
14
|
|
|
|
|
57
|
$ctx_e = $ctx->clone(); |
4791
|
14
|
|
|
|
|
110
|
$else1 = $ctx_e->exec_statement($else); |
4792
|
|
|
|
|
|
|
} |
4793
|
102
|
|
|
|
|
402
|
$ctx->update_unresolved($ctx_t); |
4794
|
102
|
100
|
|
|
|
297
|
if (defined $else) { |
4795
|
14
|
|
|
|
|
39
|
$ctx->update_unresolved($ctx_e); |
4796
|
|
|
|
|
|
|
} |
4797
|
102
|
50
|
|
|
|
203
|
if (is_instvar($cond)) { |
4798
|
0
|
|
|
|
|
0
|
$cond = $expr; |
4799
|
|
|
|
|
|
|
} |
4800
|
102
|
100
|
100
|
|
|
605
|
if (($cond ne $expr) || ($then ne $then1) || (defined $else && ($else ne $else1))) { |
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
4801
|
|
|
|
|
|
|
# put braces around simplified then/else blocks, |
4802
|
|
|
|
|
|
|
# but no brace around 'else if'. |
4803
|
|
|
|
|
|
|
# |
4804
|
72
|
100
|
100
|
|
|
247
|
if (($then ne $then1) && !is_block($then1)) { |
4805
|
2
|
|
|
|
|
16
|
$then1 = $parser->setblk('std', [$then1]); |
4806
|
|
|
|
|
|
|
} |
4807
|
72
|
50
|
100
|
|
|
203
|
if (defined $else && ($else ne $else1) && !is_block($else1)) { |
|
|
|
66
|
|
|
|
|
4808
|
0
|
|
|
|
|
0
|
$else1 = $parser->setblk('std', [$else1]); |
4809
|
|
|
|
|
|
|
} |
4810
|
72
|
|
|
|
|
285
|
my $k = $parser->setstmt(['if', $cond, $then1, $else1]); |
4811
|
72
|
50
|
|
|
|
216
|
$ctx->{log}->($ctx, 'if', $var, "simplify -> $k") if $ctx->{log}; |
4812
|
72
|
|
|
|
|
167
|
$var = $k; |
4813
|
|
|
|
|
|
|
} |
4814
|
102
|
100
|
|
|
|
254
|
if (defined $fin) { |
4815
|
8
|
|
|
|
|
17
|
my @seq = (); |
4816
|
8
|
|
|
|
|
27
|
$parser->flatten_block($fin, \@seq); |
4817
|
8
|
|
|
|
|
17
|
push(@seq, $var); |
4818
|
8
|
50
|
|
|
|
20
|
if (scalar @seq > 1) { |
|
|
0
|
|
|
|
|
|
4819
|
8
|
|
|
|
|
27
|
$var = $parser->setblk('std', [@seq]); |
4820
|
|
|
|
|
|
|
} elsif (scalar @seq > 0) { |
4821
|
0
|
|
|
|
|
0
|
$var = $seq[0]; |
4822
|
|
|
|
|
|
|
} |
4823
|
|
|
|
|
|
|
} |
4824
|
102
|
|
|
|
|
1081
|
return $var; |
4825
|
|
|
|
|
|
|
} elsif ($cmd eq 'while') { |
4826
|
10
|
|
|
|
|
18
|
my ($expr, $block) = @{$parser->{strmap}->{$var}}[1..2]; |
|
10
|
|
|
|
|
38
|
|
4827
|
|
|
|
|
|
|
|
4828
|
|
|
|
|
|
|
# - expr is recalculated on each loop |
4829
|
|
|
|
|
|
|
# (can't pre-simplify expressions like '$i < 7' or '--$x' -> 'num' or |
4830
|
|
|
|
|
|
|
# assignments, because this will lead to wrong code like 'while (1)') |
4831
|
|
|
|
|
|
|
# |
4832
|
10
|
50
|
|
|
|
42
|
unless (exists $ctx->{skip}{loop}) { |
4833
|
10
|
|
|
|
|
26
|
my $orgloop = $parser->format_stmt($var); |
4834
|
10
|
|
|
|
|
38
|
my $toploop = loop_start($parser); |
4835
|
10
|
|
|
|
|
21
|
my $i = 0; |
4836
|
10
|
|
|
|
|
13
|
my $res; |
4837
|
10
|
|
|
|
|
25
|
my @seq = (); |
4838
|
|
|
|
|
|
|
|
4839
|
10
|
|
|
|
|
14
|
while (1) { |
4840
|
18
|
|
|
|
|
52
|
my $cond = $ctx->exec_statement($expr); |
4841
|
|
|
|
|
|
|
|
4842
|
18
|
100
|
100
|
|
|
68
|
if (($i == 0) && (is_strval($cond) || (is_array($cond)))) { |
|
|
|
100
|
|
|
|
|
4843
|
|
|
|
|
|
|
# optimze 'while(0) { ... }' cases away |
4844
|
|
|
|
|
|
|
# |
4845
|
6
|
|
|
|
|
24
|
my $val = $parser->{strmap}->{$cond}; |
4846
|
6
|
100
|
|
|
|
30
|
if (is_array($cond)) { |
4847
|
1
|
|
|
|
|
7
|
my $arr = $parser->{strmap}{$cond}; |
4848
|
1
|
|
|
|
|
8
|
$val = !$arr->empty(); |
4849
|
|
|
|
|
|
|
} |
4850
|
6
|
50
|
|
|
|
44
|
if (!$val) { |
4851
|
0
|
|
|
|
|
0
|
$res = $parser->setblk('flat', []); |
4852
|
0
|
|
|
|
|
0
|
loop_end($parser, $toploop, $i); |
4853
|
0
|
|
|
|
|
0
|
return $res; |
4854
|
|
|
|
|
|
|
} |
4855
|
|
|
|
|
|
|
} |
4856
|
18
|
50
|
|
|
|
44
|
$ctx->{log}->($ctx, 'while', $var, "%d: cond result: %s -> %s", $i, $expr, $cond) if $ctx->{log}; |
4857
|
18
|
100
|
100
|
|
|
41
|
if (is_strval($cond) || is_array($cond)) { |
|
|
50
|
|
|
|
|
|
4858
|
14
|
|
|
|
|
30
|
my $val = $parser->{strmap}->{$cond}; |
4859
|
14
|
100
|
|
|
|
43
|
if (is_array($cond)) { |
4860
|
2
|
|
|
|
|
9
|
my $arr = $parser->{strmap}{$cond}; |
4861
|
2
|
|
|
|
|
401
|
$val = !$arr->empty(); |
4862
|
|
|
|
|
|
|
} |
4863
|
14
|
100
|
|
|
|
69
|
if (!$val) { |
4864
|
|
|
|
|
|
|
# loop might never execute |
4865
|
3
|
50
|
|
|
|
17
|
unless (defined $res) { |
4866
|
0
|
0
|
|
|
|
0
|
$ctx->{log}->($ctx, 'while', $var, "%d: block never executed", $i) if $ctx->{log}; |
4867
|
0
|
|
|
|
|
0
|
$res = $parser->setblk('flat', []); |
4868
|
|
|
|
|
|
|
} |
4869
|
3
|
|
|
|
|
7
|
last; |
4870
|
|
|
|
|
|
|
} |
4871
|
|
|
|
|
|
|
} elsif ($i == 0) { |
4872
|
|
|
|
|
|
|
# can't resolve expression - just return full while()-statement |
4873
|
4
|
|
|
|
|
17
|
$ctx->{warn}->($ctx, 'while', $var, "initial bad cond %s -> %s", $expr, $cond); |
4874
|
4
|
|
|
|
|
169
|
last; |
4875
|
|
|
|
|
|
|
} else { |
4876
|
0
|
|
|
|
|
0
|
$ctx->{warn}->($ctx, 'while', $var, "bad cond after %d iterations %s -> %s", $i, $expr, $cond); |
4877
|
0
|
|
|
|
|
0
|
$res = undef; |
4878
|
0
|
|
|
|
|
0
|
last; |
4879
|
|
|
|
|
|
|
} |
4880
|
|
|
|
|
|
|
# need to keep assignments in block here |
4881
|
|
|
|
|
|
|
# |
4882
|
11
|
|
|
|
|
30
|
$res = $ctx->exec_statement($block); |
4883
|
11
|
50
|
|
|
|
37
|
unless (defined $res) { |
4884
|
0
|
|
|
|
|
0
|
last; |
4885
|
|
|
|
|
|
|
} |
4886
|
11
|
|
|
|
|
52
|
my $info = {vars => {}, calls => {}, stmts => {}}; |
4887
|
11
|
|
|
|
|
38
|
$parser->stmt_info($res, $info); |
4888
|
11
|
|
|
|
|
338
|
my $r = _final_break($parser, $res, '(break)'); |
4889
|
11
|
|
|
|
|
41
|
my $u = $ctx->unresolvable_var($info); |
4890
|
11
|
|
|
|
|
27
|
my $f = _skipped_call($parser, $res, '(.*)', $info); |
4891
|
11
|
50
|
33
|
|
|
53
|
if (defined $u || (defined $f && (!defined $r || ($f ne $r)))) { |
|
|
|
66
|
|
|
|
|
|
|
|
33
|
|
|
|
|
4892
|
2
|
50
|
|
|
|
12
|
$ctx->{warn}->($ctx, 'while', $var, "skip loop after %d interations: found remaining call[%s]: %s -> %s", $i, defined $f ? $f : $u, $block, $res); |
4893
|
2
|
|
|
|
|
97
|
$res = undef; |
4894
|
2
|
|
|
|
|
12
|
last; |
4895
|
|
|
|
|
|
|
} |
4896
|
9
|
50
|
|
|
|
24
|
$ctx->{log}->($ctx, 'while', $var, "%d: block result: %s -> %s", $i, $block, $res) if $ctx->{log}; |
4897
|
9
|
100
|
|
|
|
20
|
if (defined $r) { |
4898
|
1
|
50
|
|
|
|
4
|
$ctx->{log}->($ctx, 'while', $var, "%d: block break: %s", $i, $res) if $ctx->{log}; |
4899
|
1
|
|
|
|
|
5
|
last; |
4900
|
|
|
|
|
|
|
} |
4901
|
8
|
|
|
|
|
26
|
my $fin = $ctx->insert_assignments(undef); |
4902
|
|
|
|
|
|
|
|
4903
|
8
|
|
|
|
|
19
|
my @list = (); |
4904
|
8
|
50
|
|
|
|
20
|
if (defined $fin) { |
4905
|
0
|
|
|
|
|
0
|
$parser->flatten_block($fin, \@list); |
4906
|
|
|
|
|
|
|
} |
4907
|
8
|
|
|
|
|
29
|
$parser->flatten_block($res, \@list); |
4908
|
8
|
|
|
|
|
41
|
$ctx->optimize_loop_var_list($cmd, $var, \@seq, \@list); |
4909
|
|
|
|
|
|
|
|
4910
|
8
|
50
|
|
|
|
29
|
if ($i >= $ctx->{max_loop_while}) { |
4911
|
0
|
|
|
|
|
0
|
$ctx->{warn}->($ctx, 'while', $var, "stop loop after %d [%d] iterations: $res [$expr]", $i, loop_val($parser, $i)); |
4912
|
0
|
|
|
|
|
0
|
last; |
4913
|
|
|
|
|
|
|
} |
4914
|
8
|
50
|
33
|
|
|
23
|
if ((loop_level($parser) > 1) && (loop_val($parser, $i) >= (2 * $ctx->{max_loop}))) { |
4915
|
0
|
|
|
|
|
0
|
$ctx->{warn}->($ctx, 'while', $var, "stop loop after %d nested iterations: $res [$expr]", loop_val($parser, $i)); |
4916
|
0
|
|
|
|
|
0
|
last; |
4917
|
|
|
|
|
|
|
} |
4918
|
8
|
50
|
33
|
|
|
26
|
if (($i >= $ctx->{max_loop_const}) && is_strval($expr)) { |
4919
|
|
|
|
|
|
|
# stop 'while(true)' and similay cases |
4920
|
0
|
|
|
|
|
0
|
$ctx->{warn}->($ctx, 'while', $var, "stop loop after %d const iterations: $res [$expr]", $i); |
4921
|
0
|
|
|
|
|
0
|
last; |
4922
|
|
|
|
|
|
|
} |
4923
|
8
|
|
|
|
|
31
|
$i++; |
4924
|
|
|
|
|
|
|
} |
4925
|
10
|
|
|
|
|
33
|
loop_end($parser, $toploop, $i); |
4926
|
|
|
|
|
|
|
|
4927
|
10
|
100
|
|
|
|
27
|
if (defined $res) { |
4928
|
|
|
|
|
|
|
# insert final loop var value |
4929
|
|
|
|
|
|
|
# |
4930
|
4
|
|
|
|
|
14
|
my $fin = $ctx->insert_assignments(undef); |
4931
|
4
|
100
|
|
|
|
15
|
if (defined $fin) { |
4932
|
1
|
|
|
|
|
4
|
my @list = (); |
4933
|
1
|
|
|
|
|
7
|
$parser->flatten_block($fin, \@list); |
4934
|
1
|
|
|
|
|
12
|
$ctx->optimize_loop_var_list($cmd, $var, \@seq, \@list); |
4935
|
|
|
|
|
|
|
} |
4936
|
4
|
100
|
|
|
|
17
|
if (scalar @seq > 1) { |
|
|
50
|
|
|
|
|
|
4937
|
2
|
|
|
|
|
9
|
$res = $parser->setblk('std', [@seq]); |
4938
|
|
|
|
|
|
|
} elsif (scalar @seq > 0) { |
4939
|
2
|
|
|
|
|
4
|
$res = $seq[0]; |
4940
|
|
|
|
|
|
|
} |
4941
|
4
|
50
|
|
|
|
11
|
$ctx->{log}->($ctx, 'while', $var, "optimized '%s' -> $res '%s'", $orgloop, $parser->format_stmt($res)) if $ctx->{log}; |
4942
|
4
|
|
|
|
|
16
|
return $res; |
4943
|
|
|
|
|
|
|
} |
4944
|
|
|
|
|
|
|
} |
4945
|
|
|
|
|
|
|
|
4946
|
6
|
50
|
|
|
|
23
|
if (exists $ctx->{simplify}{stmt}) { |
4947
|
6
|
50
|
|
|
|
18
|
$ctx->{log}->($ctx, 'while', $var, "simplify start %s", $parser->stmt_str($var)) if $ctx->{log}; |
4948
|
|
|
|
|
|
|
|
4949
|
|
|
|
|
|
|
# when not executed, invalidate loop variables and keep original statement |
4950
|
|
|
|
|
|
|
# - assignments might be used in next loop, so these vars are #unresolved |
4951
|
|
|
|
|
|
|
# - more vars might be changed if there are unresolvable left-hand-sides |
4952
|
|
|
|
|
|
|
# of assignments or calls, so invalidate remaining variables used in loop. |
4953
|
|
|
|
|
|
|
# |
4954
|
6
|
|
|
|
|
20
|
my $info = $ctx->get_unresolved_info($var, $var); |
4955
|
6
|
|
|
|
|
20
|
$ctx->invalidate_vars($info, 'while', $var); |
4956
|
6
|
|
|
|
|
18
|
$ctx->discard_pending_assignments(); # remove any pending assignments (from 'cond') |
4957
|
|
|
|
|
|
|
|
4958
|
|
|
|
|
|
|
# run with unresolved vars to simplify block and |
4959
|
|
|
|
|
|
|
# unresolve changed variables afterwards again. |
4960
|
|
|
|
|
|
|
# |
4961
|
6
|
|
|
|
|
15
|
my $ctx_e = $ctx->clone(); |
4962
|
6
|
|
|
|
|
20
|
my $expr0 = $ctx_e->exec_statement($expr, 1); # keep assignments inline |
4963
|
6
|
|
|
|
|
17
|
$ctx->update_unresolved($ctx_e); |
4964
|
|
|
|
|
|
|
|
4965
|
6
|
|
|
|
|
14
|
my $ctx_b = $ctx->clone(); |
4966
|
6
|
|
|
|
|
18
|
my $block0 = $ctx_b->exec_statement($block); |
4967
|
6
|
|
|
|
|
23
|
$ctx->update_unresolved($ctx_b); |
4968
|
|
|
|
|
|
|
|
4969
|
6
|
50
|
|
|
|
14
|
if (is_instvar($expr0)) { |
4970
|
0
|
|
|
|
|
0
|
$expr0 = $expr; |
4971
|
|
|
|
|
|
|
} |
4972
|
6
|
50
|
33
|
|
|
80
|
if (($expr ne $expr0) || ($block ne $block0)) { |
4973
|
0
|
|
|
|
|
0
|
my $k = $parser->setstmt(['while', $expr0, $block0]); |
4974
|
0
|
|
|
|
|
0
|
return $k; |
4975
|
|
|
|
|
|
|
} |
4976
|
|
|
|
|
|
|
} |
4977
|
6
|
|
|
|
|
17
|
return $var; |
4978
|
|
|
|
|
|
|
} elsif ($cmd eq 'do') { |
4979
|
7
|
|
|
|
|
20
|
my ($expr, $block) = @{$parser->{strmap}->{$var}}[1..2]; |
|
7
|
|
|
|
|
26
|
|
4980
|
|
|
|
|
|
|
|
4981
|
|
|
|
|
|
|
# - block is executed at least once |
4982
|
|
|
|
|
|
|
# (does optimze 'do { ... } while(0)' cases) |
4983
|
|
|
|
|
|
|
# |
4984
|
7
|
|
|
|
|
26
|
my $orgloop = $parser->format_stmt($var); |
4985
|
7
|
|
|
|
|
16
|
my @seq = (); |
4986
|
|
|
|
|
|
|
|
4987
|
7
|
|
|
|
|
22
|
my $res = $ctx->exec_statement($block); |
4988
|
7
|
50
|
|
|
|
31
|
if (defined $res) { |
4989
|
7
|
|
|
|
|
16
|
my @list = (); |
4990
|
7
|
|
|
|
|
23
|
$parser->flatten_block($res, \@list); |
4991
|
7
|
|
|
|
|
46
|
$ctx->optimize_loop_var_list($cmd, $var, \@seq, \@list); |
4992
|
|
|
|
|
|
|
} |
4993
|
7
|
50
|
|
|
|
30
|
unless (exists $ctx->{skip}{loop}) { |
4994
|
7
|
|
|
|
|
42
|
my $i = 0; |
4995
|
7
|
|
|
|
|
37
|
my $toploop = loop_start($parser); |
4996
|
|
|
|
|
|
|
|
4997
|
7
|
|
|
|
|
22
|
while (defined $res) { |
4998
|
11
|
|
|
|
|
33
|
my $cond = $ctx->exec_statement($expr); |
4999
|
|
|
|
|
|
|
|
5000
|
11
|
50
|
|
|
|
42
|
$ctx->{log}->($ctx, 'do', $var, "%d: cond result: %s -> %s", $i, $expr, $cond) if $ctx->{log}; |
5001
|
11
|
100
|
66
|
|
|
29
|
if (is_strval($cond) || is_array($cond)) { |
|
|
50
|
|
|
|
|
|
5002
|
10
|
|
|
|
|
27
|
my $val = $parser->{strmap}{$cond}; |
5003
|
10
|
50
|
|
|
|
23
|
if (is_array($cond)) { |
5004
|
0
|
|
|
|
|
0
|
my $arr = $parser->{strmap}{$cond}; |
5005
|
0
|
|
|
|
|
0
|
$val = !$arr->empty(); |
5006
|
|
|
|
|
|
|
} |
5007
|
10
|
100
|
|
|
|
30
|
if (!$val) { |
5008
|
6
|
|
|
|
|
18
|
last; |
5009
|
|
|
|
|
|
|
} |
5010
|
|
|
|
|
|
|
} elsif ($i == 0) { |
5011
|
|
|
|
|
|
|
# can't resolve expression - just return full do()-statement |
5012
|
1
|
|
|
|
|
7
|
$ctx->{warn}->($ctx, 'do', $var, "initial bad cond %s -> %s", $expr, $cond); |
5013
|
1
|
|
|
|
|
18
|
$res = undef; |
5014
|
1
|
|
|
|
|
3
|
last; |
5015
|
|
|
|
|
|
|
} else { |
5016
|
0
|
|
|
|
|
0
|
$ctx->{warn}->($ctx, 'do', $var, "bad cond after %d iterations %s -> %s", $i, $expr, $cond); |
5017
|
|
|
|
|
|
|
#$res = $parser->setblk('flat', []); |
5018
|
0
|
|
|
|
|
0
|
$res = undef; |
5019
|
0
|
|
|
|
|
0
|
last; |
5020
|
|
|
|
|
|
|
} |
5021
|
4
|
|
|
|
|
21
|
$res = $ctx->exec_statement($block); |
5022
|
4
|
50
|
|
|
|
12
|
unless (defined $res) { |
5023
|
0
|
|
|
|
|
0
|
last; |
5024
|
|
|
|
|
|
|
} |
5025
|
4
|
|
|
|
|
18
|
my $info = {vars => {}, calls => {}, stmts => {}}; |
5026
|
4
|
|
|
|
|
14
|
$parser->stmt_info($res, $info); |
5027
|
4
|
|
|
|
|
20
|
my $r = _final_break($parser, $res, '(break)'); |
5028
|
4
|
|
|
|
|
13
|
my $u = $ctx->unresolvable_var($info); |
5029
|
4
|
|
|
|
|
14
|
my $f = _skipped_call($parser, $res, '(.*)', $info); |
5030
|
4
|
0
|
0
|
|
|
19
|
if (defined $u || (defined $f && (!defined $r || ($f ne $r)))) { |
|
|
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
5031
|
0
|
0
|
|
|
|
0
|
$ctx->{warn}->($ctx, 'do', $var, "skip loop after %d interations: found remaining call[%s]: %s -> %s", $i, defined $f ? $f : $u, $block, $res); |
5032
|
0
|
|
|
|
|
0
|
$res = undef; |
5033
|
0
|
|
|
|
|
0
|
last; |
5034
|
|
|
|
|
|
|
} |
5035
|
4
|
50
|
|
|
|
13
|
$ctx->{log}->($ctx, 'do', $var, "%d: block result: %s -> %s", $i, $block, $res) if $ctx->{log}; |
5036
|
4
|
50
|
|
|
|
10
|
if (defined $r) { |
5037
|
0
|
0
|
|
|
|
0
|
$ctx->{log}->($ctx, 'do', $var, "%d: block break: %s", $i, $res) if $ctx->{log}; |
5038
|
0
|
|
|
|
|
0
|
last; |
5039
|
|
|
|
|
|
|
} |
5040
|
4
|
|
|
|
|
12
|
my $fin = $ctx->insert_assignments(undef); |
5041
|
|
|
|
|
|
|
|
5042
|
4
|
|
|
|
|
9
|
my @list = (); |
5043
|
4
|
50
|
|
|
|
11
|
if (defined $fin) { |
5044
|
0
|
|
|
|
|
0
|
$parser->flatten_block($fin, \@list); |
5045
|
|
|
|
|
|
|
} |
5046
|
4
|
|
|
|
|
15
|
$parser->flatten_block($res, \@list); |
5047
|
4
|
|
|
|
|
16
|
$ctx->optimize_loop_var_list($cmd, $var, \@seq, \@list); |
5048
|
|
|
|
|
|
|
|
5049
|
4
|
50
|
|
|
|
22
|
if ($i >= $ctx->{max_loop}) { |
5050
|
0
|
|
|
|
|
0
|
$ctx->{warn}->($ctx, 'do', $var, "stop loop after %d [%d] iterations: $res [$expr]", $i, loop_val($parser, $i)); |
5051
|
0
|
|
|
|
|
0
|
last; |
5052
|
|
|
|
|
|
|
} |
5053
|
4
|
50
|
33
|
|
|
10
|
if ((loop_level($parser) > 1) && (loop_val($parser, $i) >= (2 * $ctx->{max_loop}))) { |
5054
|
0
|
|
|
|
|
0
|
$ctx->{warn}->($ctx, 'do', $var, "stop loop after %d nested iterations: $res [$expr]", loop_val($parser, $i)); |
5055
|
0
|
|
|
|
|
0
|
last; |
5056
|
|
|
|
|
|
|
} |
5057
|
4
|
50
|
33
|
|
|
11
|
if (($i >= $ctx->{max_loop_const}) && is_strval($expr)) { |
5058
|
|
|
|
|
|
|
# stop 'while(true)' and similay cases |
5059
|
0
|
|
|
|
|
0
|
$ctx->{warn}->($ctx, 'do', $var, "stop loop after %d const iterations: $res [$expr]", $i); |
5060
|
0
|
|
|
|
|
0
|
last; |
5061
|
|
|
|
|
|
|
} |
5062
|
4
|
|
|
|
|
19
|
$i++; |
5063
|
|
|
|
|
|
|
} |
5064
|
7
|
|
|
|
|
33
|
loop_end($parser, $toploop, $i); |
5065
|
|
|
|
|
|
|
} |
5066
|
7
|
100
|
|
|
|
30
|
if (defined $res) { |
5067
|
|
|
|
|
|
|
# insert final loop var value |
5068
|
|
|
|
|
|
|
# |
5069
|
6
|
|
|
|
|
18
|
my $fin = $ctx->insert_assignments(undef); |
5070
|
6
|
100
|
|
|
|
24
|
if (defined $fin) { |
5071
|
1
|
|
|
|
|
4
|
my @list = (); |
5072
|
1
|
|
|
|
|
7
|
$parser->flatten_block($fin, \@list); |
5073
|
1
|
|
|
|
|
11
|
$ctx->optimize_loop_var_list($cmd, $var, \@seq, \@list); |
5074
|
|
|
|
|
|
|
} |
5075
|
6
|
100
|
|
|
|
31
|
if (scalar @seq > 1) { |
|
|
50
|
|
|
|
|
|
5076
|
2
|
|
|
|
|
9
|
$res = $parser->setblk('std', [@seq]); |
5077
|
|
|
|
|
|
|
} elsif (scalar @seq > 0) { |
5078
|
4
|
|
|
|
|
8
|
$res = $seq[0]; |
5079
|
|
|
|
|
|
|
} |
5080
|
6
|
50
|
|
|
|
20
|
$ctx->{log}->($ctx, 'do', $var, "optimized '%s' -> %s '%s'", $orgloop, $res, $parser->format_stmt($res)) if $ctx->{log}; |
5081
|
6
|
|
|
|
|
17
|
return $res; |
5082
|
|
|
|
|
|
|
} |
5083
|
|
|
|
|
|
|
|
5084
|
1
|
50
|
|
|
|
9
|
if (exists $ctx->{simplify}{stmt}) { |
5085
|
1
|
50
|
|
|
|
4
|
$ctx->{log}->($ctx, 'do', $var, "simplify start %s", $parser->stmt_str($var)) if $ctx->{log}; |
5086
|
|
|
|
|
|
|
|
5087
|
|
|
|
|
|
|
# when not executed, invalidate loop variables and keep original statement |
5088
|
|
|
|
|
|
|
# - assignments might be used in next loop, so these vars are #unresolved |
5089
|
|
|
|
|
|
|
# - more vars might be changed if there are unresolvable left-hand-sides |
5090
|
|
|
|
|
|
|
# of assignments or calls, so invalidate remaining variables used in loop. |
5091
|
|
|
|
|
|
|
# |
5092
|
1
|
|
|
|
|
4
|
my $info = $ctx->get_unresolved_info($var, $var); |
5093
|
1
|
|
|
|
|
5
|
$ctx->invalidate_vars($info, 'do', $var); |
5094
|
1
|
|
|
|
|
5
|
$ctx->discard_pending_assignments(); # remove any pending assignments (from block) |
5095
|
|
|
|
|
|
|
|
5096
|
|
|
|
|
|
|
# run with unresolved vars to simplify block and |
5097
|
|
|
|
|
|
|
# unresolve changed variables afterwards again. |
5098
|
|
|
|
|
|
|
# |
5099
|
1
|
|
|
|
|
4
|
my $ctx_b = $ctx->clone(); |
5100
|
1
|
|
|
|
|
4
|
my $block0 = $ctx_b->exec_statement($block); |
5101
|
1
|
|
|
|
|
20
|
$ctx->update_unresolved($ctx_b); |
5102
|
|
|
|
|
|
|
|
5103
|
1
|
|
|
|
|
3
|
my $ctx_e = $ctx->clone(); |
5104
|
1
|
|
|
|
|
7
|
my $expr0 = $ctx_e->exec_statement($expr, 1); # keep assignments inline |
5105
|
1
|
|
|
|
|
5
|
$ctx->update_unresolved($ctx_e); |
5106
|
|
|
|
|
|
|
|
5107
|
1
|
50
|
|
|
|
16
|
if (is_instvar($expr0)) { |
5108
|
0
|
|
|
|
|
0
|
$expr0 = $expr; |
5109
|
|
|
|
|
|
|
} |
5110
|
1
|
50
|
33
|
|
|
30
|
if (($expr ne $expr0) || ($block ne $block0)) { |
5111
|
0
|
|
|
|
|
0
|
my $k = $parser->setstmt(['do', $expr0, $block0]); |
5112
|
0
|
|
|
|
|
0
|
return $k; |
5113
|
|
|
|
|
|
|
} |
5114
|
|
|
|
|
|
|
} |
5115
|
1
|
|
|
|
|
5
|
return $var; |
5116
|
|
|
|
|
|
|
} elsif ($cmd eq 'for') { |
5117
|
23
|
|
|
|
|
50
|
my ($pre, $expr, $post, $block) = @{$parser->{strmap}->{$var}}[1..4]; |
|
23
|
|
|
|
|
78
|
|
5118
|
|
|
|
|
|
|
|
5119
|
|
|
|
|
|
|
# - pre is executed just once at the start of foreach |
5120
|
|
|
|
|
|
|
# - expr & post are recalculated on each loop |
5121
|
|
|
|
|
|
|
# |
5122
|
23
|
|
|
|
|
62
|
my $pre0 = $ctx->exec_statement($pre, 1); |
5123
|
|
|
|
|
|
|
|
5124
|
23
|
50
|
|
|
|
95
|
unless (exists $ctx->{skip}{loop}) { |
5125
|
23
|
|
|
|
|
77
|
my $orgloop = $parser->format_stmt($var); |
5126
|
23
|
|
|
|
|
72
|
my $toploop = loop_start($parser); |
5127
|
23
|
|
|
|
|
35
|
my $i = 0; |
5128
|
23
|
|
|
|
|
43
|
my $res; |
5129
|
23
|
|
|
|
|
52
|
my @seq = (); |
5130
|
|
|
|
|
|
|
|
5131
|
|
|
|
|
|
|
# add initial variable assignments to result list |
5132
|
|
|
|
|
|
|
# |
5133
|
23
|
|
|
|
|
38
|
my @list = (); |
5134
|
23
|
|
|
|
|
78
|
$parser->flatten_block($pre0, \@list); |
5135
|
23
|
|
|
|
|
114
|
$ctx->optimize_loop_var_list($cmd, $var, \@seq, \@list); |
5136
|
|
|
|
|
|
|
|
5137
|
23
|
|
|
|
|
32
|
while (1) { |
5138
|
53
|
|
|
|
|
128
|
my $cond = $ctx->exec_statement($expr); |
5139
|
|
|
|
|
|
|
|
5140
|
53
|
50
|
|
|
|
119
|
$ctx->{log}->($ctx, 'for', $var, "%d: cond result: %s -> %s", $i, $expr, $cond) if $ctx->{log}; |
5141
|
53
|
100
|
|
|
|
153
|
if ($parser->is_empty_block($cond)) { |
5142
|
2
|
|
|
|
|
5
|
$cond = '#null'; # null statements are eliminated in block execution |
5143
|
|
|
|
|
|
|
} |
5144
|
53
|
100
|
66
|
|
|
104
|
if (is_strval($cond) || is_array($cond)) { |
|
|
50
|
|
|
|
|
|
5145
|
48
|
|
|
|
|
115
|
my $val = $parser->{strmap}{$cond}; |
5146
|
48
|
50
|
|
|
|
136
|
if (is_array($cond)) { |
5147
|
0
|
|
|
|
|
0
|
my $arr = $parser->{strmap}{$cond}; |
5148
|
0
|
|
|
|
|
0
|
$val = !$arr->empty(); |
5149
|
|
|
|
|
|
|
} |
5150
|
48
|
100
|
|
|
|
115
|
if (!$val) { |
5151
|
|
|
|
|
|
|
# loop might never execute |
5152
|
15
|
100
|
|
|
|
43
|
unless (defined $res) { |
5153
|
3
|
50
|
|
|
|
18
|
$ctx->{log}->($ctx, 'for', $var, "%d: block $block never executed", $i) if $ctx->{log}; |
5154
|
3
|
|
|
|
|
17
|
$res = $parser->setblk('flat', []); |
5155
|
|
|
|
|
|
|
} |
5156
|
15
|
|
|
|
|
44
|
last; |
5157
|
|
|
|
|
|
|
} |
5158
|
|
|
|
|
|
|
} elsif ($i == 0) { |
5159
|
|
|
|
|
|
|
# can't resolve expression - just return full for()-statement |
5160
|
5
|
|
|
|
|
15
|
last; |
5161
|
|
|
|
|
|
|
} else { |
5162
|
0
|
|
|
|
|
0
|
$ctx->{warn}->($ctx, 'for', $var, "bad cond after %d iterations %s -> %s", $i, $expr, $cond); |
5163
|
|
|
|
|
|
|
#$res = $parser->setblk('flat', []); |
5164
|
0
|
|
|
|
|
0
|
$res = undef; |
5165
|
0
|
|
|
|
|
0
|
last; |
5166
|
|
|
|
|
|
|
} |
5167
|
33
|
|
|
|
|
89
|
$res = $ctx->exec_statement($block); |
5168
|
33
|
50
|
|
|
|
85
|
unless (defined $res) { |
5169
|
0
|
|
|
|
|
0
|
last; |
5170
|
|
|
|
|
|
|
} |
5171
|
33
|
|
|
|
|
144
|
my $info = {vars => {}, calls => {}, stmts => {}}; |
5172
|
33
|
|
|
|
|
117
|
$parser->stmt_info($res, $info); |
5173
|
33
|
|
|
|
|
76
|
my $r = _final_break($parser, $res, '(break)'); |
5174
|
33
|
|
|
|
|
91
|
my $u = $ctx->unresolvable_var($info); |
5175
|
33
|
|
|
|
|
76
|
my $f = _skipped_call($parser, $res, '(.*)', $info); |
5176
|
33
|
50
|
0
|
|
|
155
|
if (defined $u || (defined $f && (!defined $r || ($f ne $r)))) { |
|
|
|
33
|
|
|
|
|
|
|
|
66
|
|
|
|
|
5177
|
3
|
50
|
|
|
|
30
|
$ctx->{warn}->($ctx, 'for', $var, "skip loop after %d interations: found remaining call[%s]: '%s' %s -> %s", $i, defined $f ? $f : $u, $orgloop, $block, $res); |
5178
|
3
|
|
|
|
|
229
|
$res = undef; |
5179
|
3
|
|
|
|
|
16
|
last; |
5180
|
|
|
|
|
|
|
} |
5181
|
30
|
50
|
|
|
|
66
|
$ctx->{log}->($ctx, 'for', $var, "%d: block result: %s -> %s", $i, $block, $res) if $ctx->{log}; |
5182
|
30
|
50
|
|
|
|
117
|
if (defined $r) { |
5183
|
0
|
0
|
|
|
|
0
|
$ctx->{log}->($ctx, 'for', $var, "%d: block break: %s", $i, $res) if $ctx->{log}; |
5184
|
0
|
|
|
|
|
0
|
last; |
5185
|
|
|
|
|
|
|
} |
5186
|
|
|
|
|
|
|
# recalculate post on each loop |
5187
|
|
|
|
|
|
|
# |
5188
|
30
|
|
|
|
|
81
|
my $fin = $ctx->insert_assignments(undef); |
5189
|
|
|
|
|
|
|
|
5190
|
30
|
|
|
|
|
84
|
my @list = (); |
5191
|
30
|
50
|
|
|
|
61
|
if (defined $fin) { |
5192
|
0
|
|
|
|
|
0
|
$parser->flatten_block($fin, \@list); |
5193
|
|
|
|
|
|
|
} |
5194
|
30
|
|
|
|
|
101
|
$parser->flatten_block($res, \@list); |
5195
|
30
|
|
|
|
|
103
|
$ctx->optimize_loop_var_list($cmd, $var, \@seq, \@list); |
5196
|
|
|
|
|
|
|
|
5197
|
30
|
|
|
|
|
96
|
my $post0 = $ctx->exec_statement($post); |
5198
|
30
|
50
|
|
|
|
78
|
$ctx->{log}->($ctx, 'for', $var, "%d: post result: %s -> %s", $i, $post, $post0) if $ctx->{log}; |
5199
|
|
|
|
|
|
|
|
5200
|
30
|
50
|
|
|
|
76
|
if ($i >= $ctx->{max_loop}) { |
5201
|
0
|
|
|
|
|
0
|
$ctx->{warn}->($ctx, 'for', $var, "stop loop after %d [%d] iterations: $res [$expr]", $i, loop_val($parser, $i)); |
5202
|
0
|
|
|
|
|
0
|
last; |
5203
|
|
|
|
|
|
|
} |
5204
|
30
|
50
|
33
|
|
|
69
|
if ((loop_level($parser) > 1) && (loop_val($parser, $i) >= (2 * $ctx->{max_loop}))) { |
5205
|
0
|
|
|
|
|
0
|
$ctx->{warn}->($ctx, 'for', $var, "stop loop after %d nested iterations: $res [$expr]", loop_val($parser, $i)); |
5206
|
0
|
|
|
|
|
0
|
last; |
5207
|
|
|
|
|
|
|
} |
5208
|
30
|
|
|
|
|
124
|
$i++; |
5209
|
|
|
|
|
|
|
} |
5210
|
23
|
|
|
|
|
87
|
loop_end($parser, $toploop, $i); |
5211
|
|
|
|
|
|
|
|
5212
|
23
|
100
|
|
|
|
86
|
if (defined $res) { |
5213
|
|
|
|
|
|
|
# insert final loop var value |
5214
|
|
|
|
|
|
|
# |
5215
|
15
|
|
|
|
|
46
|
my $fin = $ctx->insert_assignments(undef); |
5216
|
15
|
100
|
|
|
|
74
|
if (defined $fin) { |
5217
|
14
|
|
|
|
|
22
|
my @list = (); |
5218
|
14
|
|
|
|
|
46
|
$parser->flatten_block($fin, \@list); |
5219
|
14
|
|
|
|
|
43
|
$ctx->optimize_loop_var_list($cmd, $var, \@seq, \@list); |
5220
|
|
|
|
|
|
|
} |
5221
|
|
|
|
|
|
|
# todo: can getting very long statement list here for seq - just return values from last loop |
5222
|
|
|
|
|
|
|
# |
5223
|
15
|
100
|
|
|
|
51
|
if (scalar @seq > 1) { |
|
|
50
|
|
|
|
|
|
5224
|
14
|
|
|
|
|
56
|
$res = $parser->setblk('std', [@seq]); |
5225
|
|
|
|
|
|
|
} elsif (scalar @seq > 0) { |
5226
|
1
|
|
|
|
|
19
|
$res = $seq[0]; |
5227
|
|
|
|
|
|
|
} |
5228
|
15
|
50
|
|
|
|
43
|
$ctx->{log}->($ctx, 'for', $var, "optimized '%s' -> %s '%s'", $orgloop, $res, $parser->format_stmt($res)) if $ctx->{log}; |
5229
|
15
|
|
|
|
|
55
|
return $res; |
5230
|
|
|
|
|
|
|
} |
5231
|
|
|
|
|
|
|
} |
5232
|
|
|
|
|
|
|
|
5233
|
8
|
50
|
|
|
|
39
|
if (exists $ctx->{simplify}{stmt}) { |
5234
|
8
|
50
|
|
|
|
37
|
$ctx->{log}->($ctx, 'for', $var, "simplify start %s", $parser->stmt_str($var)) if $ctx->{log}; |
5235
|
|
|
|
|
|
|
|
5236
|
|
|
|
|
|
|
# when not executed, invalidate loop variables and keep original statement |
5237
|
|
|
|
|
|
|
# - key/value change for each loop, so they are #unresolved |
5238
|
|
|
|
|
|
|
# - assignments might be used in next loop, so these vars are #unresolved |
5239
|
|
|
|
|
|
|
# - more vars might be changed if there are unresolvable left-hand-sides |
5240
|
|
|
|
|
|
|
# of assignments or calls, so invalidate remaining variables used in loop. |
5241
|
|
|
|
|
|
|
# |
5242
|
8
|
|
|
|
|
22
|
my $var0 = $var; |
5243
|
8
|
50
|
|
|
|
22
|
if ($pre ne $pre0) { |
5244
|
0
|
|
|
|
|
0
|
$var0 = $parser->setstmt(['for', $pre0, $expr, $post, $block]); |
5245
|
|
|
|
|
|
|
} |
5246
|
8
|
|
|
|
|
34
|
my $info = $ctx->get_unresolved_info($var, $var0); |
5247
|
8
|
|
|
|
|
63
|
$ctx->invalidate_vars($info, 'for', $var); |
5248
|
8
|
|
|
|
|
44
|
$ctx->discard_pending_assignments(); # remove any pending assignments (from 'cond') |
5249
|
|
|
|
|
|
|
|
5250
|
|
|
|
|
|
|
# run with unresolved vars to simplify block and |
5251
|
|
|
|
|
|
|
# unresolve changed variables afterwards again. |
5252
|
|
|
|
|
|
|
# |
5253
|
8
|
|
|
|
|
23
|
my $ctx_e = $ctx->clone(); |
5254
|
8
|
|
|
|
|
81
|
my $expr0 = $ctx_e->exec_statement($expr, 1); # keep assignments inline |
5255
|
8
|
|
|
|
|
48
|
$ctx->update_unresolved($ctx_e); |
5256
|
|
|
|
|
|
|
|
5257
|
8
|
|
|
|
|
29
|
my $ctx_b = $ctx->clone(); |
5258
|
8
|
|
|
|
|
46
|
my $block0 = $ctx_b->exec_statement($block); |
5259
|
8
|
|
|
|
|
58
|
$ctx->update_unresolved($ctx_b); |
5260
|
|
|
|
|
|
|
|
5261
|
8
|
|
|
|
|
24
|
my $ctx_p = $ctx->clone(); |
5262
|
8
|
|
|
|
|
29
|
my $post0 = $ctx_p->exec_statement($post, 1); # keep assignments inline |
5263
|
8
|
|
|
|
|
54
|
$ctx->update_unresolved($ctx_p); |
5264
|
|
|
|
|
|
|
|
5265
|
8
|
50
|
|
|
|
36
|
if (is_instvar($expr0)) { |
5266
|
0
|
|
|
|
|
0
|
$expr0 = $expr; |
5267
|
|
|
|
|
|
|
} |
5268
|
8
|
100
|
33
|
|
|
175
|
if (($pre ne $pre0) || ($expr ne $expr0) || ($post ne $post0) || ($block ne $block0)) { |
|
|
|
33
|
|
|
|
|
|
|
|
66
|
|
|
|
|
5269
|
1
|
|
|
|
|
15
|
my $k = $parser->setstmt(['for', $pre0, $expr0, $post0, $block0]); |
5270
|
1
|
|
|
|
|
16
|
return $k; |
5271
|
|
|
|
|
|
|
} |
5272
|
|
|
|
|
|
|
} |
5273
|
7
|
|
|
|
|
28
|
return $var; |
5274
|
|
|
|
|
|
|
} elsif ($cmd eq 'foreach') { |
5275
|
19
|
|
|
|
|
50
|
my ($expr, $key, $value, $block) = @{$parser->{strmap}->{$var}}[1..4]; |
|
19
|
|
|
|
|
73
|
|
5276
|
19
|
|
|
|
|
40
|
my $valvar; |
5277
|
|
|
|
|
|
|
my $keyvar; |
5278
|
|
|
|
|
|
|
|
5279
|
|
|
|
|
|
|
# - expr is executed just once at the start of foreach |
5280
|
|
|
|
|
|
|
# - key and value are recalculated on each loop |
5281
|
|
|
|
|
|
|
# - TODO: reference on value var |
5282
|
|
|
|
|
|
|
# |
5283
|
19
|
|
|
|
|
49
|
my $expr0 = $ctx->exec_statement($expr); |
5284
|
|
|
|
|
|
|
|
5285
|
19
|
100
|
|
|
|
69
|
if (defined $key) { |
5286
|
13
|
|
|
|
|
44
|
my ($_basevar2, $_has_index2, $_idxstr2) = $ctx->resolve_variable($key, $in_block); |
5287
|
13
|
50
|
|
|
|
62
|
$keyvar = defined $_basevar2 ? $_basevar2 : $key; |
5288
|
|
|
|
|
|
|
} |
5289
|
19
|
|
|
|
|
60
|
my ($_basevar, $_has_index, $_idxstr) = $ctx->resolve_variable($value, $in_block); |
5290
|
19
|
50
|
|
|
|
56
|
$valvar = defined $_basevar ? $_basevar : $value; |
5291
|
|
|
|
|
|
|
|
5292
|
|
|
|
|
|
|
# loop should be unrolled only after variables are available |
5293
|
19
|
50
|
|
|
|
61
|
unless (exists $ctx->{skip}{loop}) { |
5294
|
19
|
|
|
|
|
64
|
my $orgloop = $parser->format_stmt($var); |
5295
|
19
|
|
|
|
|
76
|
my $toploop = loop_start($parser); |
5296
|
19
|
|
|
|
|
42
|
my $i = 0; |
5297
|
19
|
|
|
|
|
28
|
my $res; |
5298
|
19
|
|
|
|
|
32
|
my @seq = (); |
5299
|
|
|
|
|
|
|
|
5300
|
19
|
100
|
|
|
|
56
|
if (is_array($expr0)) { |
5301
|
|
|
|
|
|
|
#my ($a2, $array2) = $parser->copyarr($expr0); # copy if value not reference |
5302
|
|
|
|
|
|
|
#$expr0 = $a2; |
5303
|
11
|
|
|
|
|
36
|
my $arr = $parser->{strmap}{$expr0}; |
5304
|
11
|
|
|
|
|
35
|
my $keys = $arr->get_keys(); |
5305
|
|
|
|
|
|
|
|
5306
|
|
|
|
|
|
|
# loop might never execute |
5307
|
11
|
50
|
33
|
|
|
67
|
if ((scalar @$keys == 0) && !$ctx->{tainted}) { |
5308
|
0
|
0
|
|
|
|
0
|
$ctx->{log}->($ctx, 'foreach', $var, "block $block never executed") if $ctx->{log}; |
5309
|
0
|
|
|
|
|
0
|
$res = $parser->setblk('flat', []); |
5310
|
|
|
|
|
|
|
} |
5311
|
11
|
|
|
|
|
28
|
foreach my $k (@$keys) { |
5312
|
23
|
50
|
66
|
|
|
94
|
if (defined $key && defined $keyvar && is_variable($keyvar)) { |
|
|
|
66
|
|
|
|
|
5313
|
17
|
50
|
|
|
|
44
|
if (is_int_index($k)) { |
5314
|
17
|
|
|
|
|
58
|
my $kstr = $parser->setnum($k); |
5315
|
17
|
|
|
|
|
47
|
$ctx->{varmap}{$keyvar} = $kstr; |
5316
|
|
|
|
|
|
|
} else { |
5317
|
0
|
|
|
|
|
0
|
$ctx->{varmap}{$keyvar} = $k; |
5318
|
|
|
|
|
|
|
} |
5319
|
|
|
|
|
|
|
} |
5320
|
23
|
50
|
33
|
|
|
73
|
if (defined $valvar && is_variable($valvar)) { |
5321
|
23
|
|
|
|
|
71
|
my $arrval = $arr->val($k); |
5322
|
23
|
|
|
|
|
61
|
$ctx->{varmap}{$valvar} = $arrval; |
5323
|
|
|
|
|
|
|
} |
5324
|
23
|
|
|
|
|
55
|
$res = $ctx->exec_statement($block); |
5325
|
23
|
50
|
|
|
|
75
|
unless (defined $res) { |
5326
|
0
|
|
|
|
|
0
|
last; |
5327
|
|
|
|
|
|
|
} |
5328
|
23
|
|
|
|
|
116
|
my $info = {vars => {}, calls => {}, stmts => {}}; |
5329
|
23
|
|
|
|
|
87
|
$parser->stmt_info($res, $info); |
5330
|
23
|
|
|
|
|
56
|
my $r = _final_break($parser, $res, '(break)'); |
5331
|
23
|
|
|
|
|
60
|
my $u = $ctx->unresolvable_var($info); |
5332
|
23
|
|
|
|
|
57
|
my $f = _skipped_call($parser, $res, '(.*)', $info); |
5333
|
23
|
50
|
33
|
|
|
94
|
if (defined $u || (defined $f && (!defined $r || ($f ne $r)))) { |
|
|
|
66
|
|
|
|
|
|
|
|
66
|
|
|
|
|
5334
|
2
|
50
|
|
|
|
14
|
$ctx->{warn}->($ctx, 'foreach', $var, "skip loop after %d interations (key %s): found remaining call[%s]: %s -> %s", $i, $k, defined $f ? $f : $u, $block, $res); |
5335
|
2
|
|
|
|
|
98
|
$res = undef; |
5336
|
2
|
|
|
|
|
16
|
last; |
5337
|
|
|
|
|
|
|
} |
5338
|
21
|
50
|
|
|
|
44
|
if (defined $r) { |
5339
|
0
|
0
|
|
|
|
0
|
$ctx->{log}->($ctx, 'foreach', $var, "%s: block break: %s", $k, $res) if $ctx->{log}; |
5340
|
0
|
|
|
|
|
0
|
last; |
5341
|
|
|
|
|
|
|
} |
5342
|
21
|
|
|
|
|
55
|
my $fin = $ctx->insert_assignments(undef); |
5343
|
|
|
|
|
|
|
|
5344
|
21
|
|
|
|
|
43
|
my @list = (); |
5345
|
21
|
50
|
|
|
|
41
|
if (defined $fin) { |
5346
|
0
|
|
|
|
|
0
|
$parser->flatten_block($fin, \@list); |
5347
|
|
|
|
|
|
|
} |
5348
|
21
|
|
|
|
|
66
|
$parser->flatten_block($res, \@list); |
5349
|
21
|
|
|
|
|
71
|
$ctx->optimize_loop_var_list($cmd, $var, \@seq, \@list); |
5350
|
|
|
|
|
|
|
|
5351
|
|
|
|
|
|
|
# recalculate key & value on each loop |
5352
|
|
|
|
|
|
|
# |
5353
|
21
|
100
|
66
|
|
|
131
|
if (defined $key && defined $keyvar && ($keyvar ne $key)) { |
|
|
|
100
|
|
|
|
|
5354
|
9
|
|
|
|
|
25
|
my ($_basevar2, $_has_index2, $_idxstr2) = $ctx->resolve_variable($key, $in_block); |
5355
|
9
|
50
|
|
|
|
30
|
$keyvar = defined $_basevar2 ? $_basevar2 : $key; |
5356
|
|
|
|
|
|
|
} |
5357
|
21
|
100
|
66
|
|
|
69
|
if (defined $valvar && ($valvar ne $value)) { |
5358
|
11
|
|
|
|
|
27
|
my ($_basevar, $_has_index, $_idxstr) = $ctx->resolve_variable($value, $in_block); |
5359
|
11
|
50
|
|
|
|
29
|
$valvar = defined $_basevar ? $_basevar : $value; |
5360
|
|
|
|
|
|
|
} |
5361
|
21
|
|
|
|
|
91
|
$i++; |
5362
|
|
|
|
|
|
|
} |
5363
|
|
|
|
|
|
|
} else { |
5364
|
8
|
50
|
|
|
|
29
|
$ctx->{log}->($ctx, 'foreach', $var, "can't handle expr: %s (%s)", $expr, $expr0) if $ctx->{log}; |
5365
|
|
|
|
|
|
|
} |
5366
|
19
|
|
|
|
|
78
|
loop_end($parser, $toploop, $i); |
5367
|
|
|
|
|
|
|
|
5368
|
19
|
100
|
|
|
|
48
|
if (defined $res) { |
5369
|
|
|
|
|
|
|
# insert final loop var value |
5370
|
|
|
|
|
|
|
# |
5371
|
9
|
|
|
|
|
29
|
my $fin = $ctx->insert_assignments(undef); |
5372
|
9
|
50
|
|
|
|
27
|
if (defined $fin) { |
5373
|
0
|
|
|
|
|
0
|
my @list = (); |
5374
|
0
|
|
|
|
|
0
|
$parser->flatten_block($fin, \@list); |
5375
|
0
|
|
|
|
|
0
|
$ctx->optimize_loop_var_list($cmd, $var, \@seq, \@list); |
5376
|
|
|
|
|
|
|
} |
5377
|
|
|
|
|
|
|
# todo: can getting very long statement list here for seq - just return values from last loop |
5378
|
|
|
|
|
|
|
# |
5379
|
9
|
100
|
|
|
|
28
|
if (scalar @seq > 1) { |
|
|
50
|
|
|
|
|
|
5380
|
6
|
|
|
|
|
32
|
$res = $parser->setblk('std', [@seq]); |
5381
|
|
|
|
|
|
|
} elsif (scalar @seq > 0) { |
5382
|
3
|
|
|
|
|
8
|
$res = $seq[0]; |
5383
|
|
|
|
|
|
|
} |
5384
|
9
|
50
|
|
|
|
33
|
$ctx->{log}->($ctx, 'foreach', $var, "optimized '%s' -> %s '%s'", $orgloop, $res, $parser->format_stmt($res)) if $ctx->{log}; |
5385
|
9
|
|
|
|
|
40
|
return $res; |
5386
|
|
|
|
|
|
|
} |
5387
|
|
|
|
|
|
|
} |
5388
|
|
|
|
|
|
|
|
5389
|
10
|
50
|
|
|
|
32
|
if (exists $ctx->{simplify}{stmt}) { |
5390
|
10
|
50
|
|
|
|
24
|
$ctx->{log}->($ctx, 'foreach', $var, "simplify start %s", $parser->stmt_str($var)) if $ctx->{log}; |
5391
|
|
|
|
|
|
|
|
5392
|
|
|
|
|
|
|
# when not executed, invalidate loop variables and keep original statement |
5393
|
|
|
|
|
|
|
# - key/value change for each loop, so they are #unresolved |
5394
|
|
|
|
|
|
|
# - assignments might be used in next loop, so these vars are #unresolved |
5395
|
|
|
|
|
|
|
# - more vars might be changed if there are unresolvable left-hand-sides |
5396
|
|
|
|
|
|
|
# of assignments or calls, so invalidate remaining variables used in loop. |
5397
|
|
|
|
|
|
|
# |
5398
|
10
|
|
|
|
|
22
|
my $var0 = $var; |
5399
|
10
|
100
|
|
|
|
28
|
if ($expr ne $expr0) { |
5400
|
|
|
|
|
|
|
# use expr with removed assignments |
5401
|
4
|
|
|
|
|
21
|
$var0 = $parser->setstmt(['foreach', $expr0, $key, $value, $block]); |
5402
|
|
|
|
|
|
|
} |
5403
|
10
|
|
|
|
|
35
|
my $info = $ctx->get_unresolved_info($var, $var0); |
5404
|
10
|
|
|
|
|
49
|
$ctx->invalidate_vars($info, 'foreach', $var); |
5405
|
|
|
|
|
|
|
|
5406
|
|
|
|
|
|
|
# run with unresolved vars to simplify block and |
5407
|
|
|
|
|
|
|
# unresolve changed variables afterwards again. |
5408
|
|
|
|
|
|
|
# |
5409
|
10
|
|
|
|
|
28
|
my $ctx_b = $ctx->clone(); |
5410
|
10
|
|
|
|
|
43
|
my $block0 = $ctx_b->exec_statement($block); |
5411
|
10
|
|
|
|
|
51
|
$ctx->update_unresolved($ctx_b); |
5412
|
|
|
|
|
|
|
|
5413
|
10
|
50
|
100
|
|
|
115
|
if (($expr ne $expr0) || ($block ne $block0) || (defined $valvar && ($value ne $valvar)) || (defined $key && defined $keyvar && ($key ne $keyvar))) { |
|
|
|
33
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
|
33
|
|
|
|
|
5414
|
|
|
|
|
|
|
# simplify elem expression |
5415
|
|
|
|
|
|
|
# |
5416
|
8
|
|
|
|
|
42
|
my $k = $parser->setstmt(['foreach', $expr0, $keyvar, $valvar, $block0]); |
5417
|
8
|
50
|
|
|
|
36
|
$ctx->{log}->($ctx, 'foreach', $var, "simplify -> $k") if $ctx->{log}; |
5418
|
8
|
|
|
|
|
99
|
return $k; |
5419
|
|
|
|
|
|
|
} |
5420
|
|
|
|
|
|
|
} |
5421
|
2
|
|
|
|
|
8
|
return $var; |
5422
|
|
|
|
|
|
|
} elsif ($cmd eq 'switch') { |
5423
|
9
|
|
|
|
|
19
|
my ($expr, $cases) = @{$parser->{strmap}->{$var}}[1..2]; |
|
9
|
|
|
|
|
30
|
|
5424
|
9
|
|
|
|
|
31
|
my $op1 = $ctx->exec_statement($expr); |
5425
|
|
|
|
|
|
|
|
5426
|
|
|
|
|
|
|
# insert possible assignment from expr |
5427
|
|
|
|
|
|
|
# |
5428
|
9
|
|
|
|
|
30
|
my $fin = $ctx->insert_assignments(undef); |
5429
|
|
|
|
|
|
|
|
5430
|
9
|
100
|
|
|
|
43
|
if (is_strval($op1)) { |
5431
|
3
|
|
|
|
|
7
|
my $found; |
5432
|
3
|
|
|
|
|
9
|
my @seq = (); |
5433
|
|
|
|
|
|
|
|
5434
|
3
|
50
|
|
|
|
9
|
$parser->flatten_block($fin, \@seq) if defined $fin; |
5435
|
3
|
|
|
|
|
6
|
$fin = undef; |
5436
|
|
|
|
|
|
|
|
5437
|
3
|
|
|
|
|
15
|
for (my $i=0; $i < scalar @$cases; $i++) { |
5438
|
5
|
|
|
|
|
13
|
my $e = $cases->[$i]; |
5439
|
5
|
|
|
|
|
10
|
my $c = $e->[0]; |
5440
|
5
|
50
|
|
|
|
10
|
if (defined $c) { |
5441
|
5
|
|
|
|
|
14
|
my $op2 = $ctx->exec_statement($c); |
5442
|
5
|
50
|
|
|
|
30
|
if (is_strval($op2)) { |
5443
|
5
|
|
|
|
|
25
|
my ($val, $result) = PHP::Decode::Op::binary($parser, $op1, '==', $op2); |
5444
|
5
|
100
|
66
|
|
|
28
|
if (defined $result && $result) { |
5445
|
3
|
|
|
|
|
6
|
$found = $i; |
5446
|
3
|
|
|
|
|
6
|
last; |
5447
|
|
|
|
|
|
|
} |
5448
|
|
|
|
|
|
|
} else { |
5449
|
0
|
|
|
|
|
0
|
$ctx->{warn}->($ctx, 'switch', $var, "bad cond %s == %s -> %s", $op1, $c, $op2); |
5450
|
0
|
|
|
|
|
0
|
$found = -1; |
5451
|
0
|
|
|
|
|
0
|
last; |
5452
|
|
|
|
|
|
|
} |
5453
|
|
|
|
|
|
|
} |
5454
|
|
|
|
|
|
|
} |
5455
|
3
|
50
|
|
|
|
11
|
if (!defined $found) { |
5456
|
|
|
|
|
|
|
# process 'default:' |
5457
|
|
|
|
|
|
|
# |
5458
|
0
|
|
|
|
|
0
|
for (my $i=0; $i < scalar @$cases; $i++) { |
5459
|
0
|
|
|
|
|
0
|
my $e = $cases->[$i]; |
5460
|
0
|
|
|
|
|
0
|
my $c = $e->[0]; |
5461
|
0
|
0
|
|
|
|
0
|
if (!defined $c) { |
5462
|
0
|
|
|
|
|
0
|
$found = $i; |
5463
|
0
|
|
|
|
|
0
|
last; |
5464
|
|
|
|
|
|
|
} |
5465
|
|
|
|
|
|
|
} |
5466
|
|
|
|
|
|
|
} |
5467
|
3
|
50
|
33
|
|
|
16
|
if (defined $found && ($found >= 0)) { |
5468
|
3
|
|
|
|
|
10
|
for (my $i=$found; $i < scalar @$cases; $i++) { |
5469
|
4
|
|
|
|
|
8
|
my $e = $cases->[$i]; |
5470
|
4
|
|
|
|
|
5
|
my $b = $e->[1]; |
5471
|
4
|
|
|
|
|
11
|
my $res = $ctx->exec_statement($b); |
5472
|
4
|
50
|
|
|
|
11
|
unless (defined $res) { |
5473
|
0
|
|
|
|
|
0
|
last; |
5474
|
|
|
|
|
|
|
} |
5475
|
4
|
|
|
|
|
7
|
my @list = (); |
5476
|
4
|
|
|
|
|
7
|
my $f = _final_break($parser, $res, '(break|continue|return)'); |
5477
|
4
|
100
|
|
|
|
13
|
if (defined $f) { |
5478
|
1
|
|
|
|
|
5
|
$res = _remove_final_statement($parser, '(break|continue)', $res); |
5479
|
|
|
|
|
|
|
} |
5480
|
4
|
|
|
|
|
14
|
$parser->flatten_block($res, \@list); |
5481
|
4
|
|
|
|
|
28
|
$ctx->optimize_loop_var_list($cmd, $var, \@seq, \@list); |
5482
|
4
|
100
|
|
|
|
13
|
if (defined $f) { |
5483
|
1
|
|
|
|
|
3
|
last; |
5484
|
|
|
|
|
|
|
} |
5485
|
|
|
|
|
|
|
} |
5486
|
|
|
|
|
|
|
# convert std blocks to flat |
5487
|
|
|
|
|
|
|
# |
5488
|
3
|
|
|
|
|
6
|
my $res; |
5489
|
3
|
50
|
|
|
|
12
|
if (scalar @seq > 1) { |
|
|
50
|
|
|
|
|
|
5490
|
0
|
|
|
|
|
0
|
$res = $parser->setblk('flat', [@seq]); |
5491
|
|
|
|
|
|
|
} elsif (scalar @seq > 0) { |
5492
|
3
|
|
|
|
|
7
|
$res = $seq[0]; |
5493
|
|
|
|
|
|
|
} else { |
5494
|
0
|
|
|
|
|
0
|
$res = $parser->setblk('flat', []); |
5495
|
|
|
|
|
|
|
} |
5496
|
3
|
|
|
|
|
9
|
return $res; |
5497
|
|
|
|
|
|
|
} |
5498
|
|
|
|
|
|
|
} |
5499
|
|
|
|
|
|
|
|
5500
|
6
|
50
|
|
|
|
43
|
if (exists $ctx->{simplify}{stmt}) { |
5501
|
6
|
50
|
|
|
|
24
|
$ctx->{log}->($ctx, 'switch', $var, "simplify start %s", $parser->stmt_str($var)) if $ctx->{log}; |
5502
|
|
|
|
|
|
|
|
5503
|
|
|
|
|
|
|
# invalidate variables first to avoid '#null' compares |
5504
|
|
|
|
|
|
|
# - since there are 'fallthrough' dependencies between |
5505
|
|
|
|
|
|
|
# case blocks, all variables need to be invalidated. |
5506
|
|
|
|
|
|
|
# |
5507
|
6
|
|
|
|
|
15
|
my $var0 = $var; |
5508
|
6
|
50
|
|
|
|
18
|
if ($expr ne $op1) { |
5509
|
|
|
|
|
|
|
# use cond with removed assignments |
5510
|
0
|
|
|
|
|
0
|
$var0 = $parser->setstmt(['switch', $op1, $cases]); |
5511
|
|
|
|
|
|
|
} |
5512
|
6
|
|
|
|
|
18
|
my $info = $ctx->get_unresolved_info($var, $var0); |
5513
|
|
|
|
|
|
|
#$ctx->invalidate_undefined_vars($info, 'switch', $var); |
5514
|
6
|
|
|
|
|
54
|
$ctx->invalidate_vars($info, 'switch', $var); |
5515
|
|
|
|
|
|
|
|
5516
|
|
|
|
|
|
|
# run with unresolved vars to simplify then/else and |
5517
|
|
|
|
|
|
|
# unresolve changed variables afterwards again. |
5518
|
|
|
|
|
|
|
# |
5519
|
6
|
|
|
|
|
21
|
my @cnew = (); |
5520
|
6
|
|
|
|
|
14
|
my @cctx = (); |
5521
|
6
|
|
|
|
|
10
|
my $changed = 0; |
5522
|
6
|
|
|
|
|
27
|
for (my $i=0; $i < scalar @$cases; $i++) { |
5523
|
8
|
|
|
|
|
19
|
my $e = $cases->[$i]; |
5524
|
8
|
|
|
|
|
12
|
my $c = $e->[0]; |
5525
|
8
|
|
|
|
|
18
|
my $b = $e->[1]; |
5526
|
8
|
|
|
|
|
15
|
my $c0 = $c; |
5527
|
|
|
|
|
|
|
|
5528
|
8
|
|
|
|
|
39
|
$cctx[$i] = $ctx->clone(); |
5529
|
8
|
50
|
|
|
|
36
|
if (defined $c) { |
5530
|
8
|
|
|
|
|
37
|
$c0 = $cctx[$i]->exec_statement($c); |
5531
|
|
|
|
|
|
|
} |
5532
|
8
|
|
|
|
|
47
|
my $b0 = $cctx[$i]->exec_statement($b); |
5533
|
|
|
|
|
|
|
|
5534
|
8
|
100
|
66
|
|
|
63
|
if ((defined $c0 && ($c0 ne $c)) || ($b0 ne $b)) { |
|
|
|
66
|
|
|
|
|
5535
|
2
|
|
|
|
|
4
|
$changed = 1; |
5536
|
|
|
|
|
|
|
} |
5537
|
8
|
|
|
|
|
38
|
push (@cnew, [$c0, $b0]); |
5538
|
|
|
|
|
|
|
} |
5539
|
6
|
|
|
|
|
27
|
for (my $i=0; $i < scalar @$cases; $i++) { |
5540
|
8
|
|
|
|
|
33
|
$ctx->update_unresolved($cctx[$i]); |
5541
|
|
|
|
|
|
|
} |
5542
|
|
|
|
|
|
|
|
5543
|
6
|
100
|
66
|
|
|
38
|
if (($expr ne $op1) || $changed) { |
5544
|
2
|
|
|
|
|
11
|
my $k = $parser->setstmt(['switch', $op1, \@cnew]); |
5545
|
2
|
50
|
|
|
|
10
|
$ctx->{log}->($ctx, 'switch', $var, "simplify -> $k") if $ctx->{log}; |
5546
|
2
|
|
|
|
|
4
|
$var = $k; |
5547
|
2
|
|
|
|
|
21
|
return $k; |
5548
|
|
|
|
|
|
|
} |
5549
|
4
|
50
|
|
|
|
49
|
if (defined $fin) { |
5550
|
0
|
|
|
|
|
0
|
my @seq = (); |
5551
|
0
|
|
|
|
|
0
|
$parser->flatten_block($fin, \@seq); |
5552
|
0
|
|
|
|
|
0
|
push(@seq, $var); |
5553
|
0
|
0
|
|
|
|
0
|
if (scalar @seq > 1) { |
|
|
0
|
|
|
|
|
|
5554
|
0
|
|
|
|
|
0
|
$var = $parser->setblk('std', [@seq]); |
5555
|
|
|
|
|
|
|
} elsif (scalar @seq > 0) { |
5556
|
0
|
|
|
|
|
0
|
$var = $seq[0]; |
5557
|
|
|
|
|
|
|
} |
5558
|
|
|
|
|
|
|
} |
5559
|
|
|
|
|
|
|
} |
5560
|
4
|
|
|
|
|
12
|
return $var; |
5561
|
|
|
|
|
|
|
} |
5562
|
|
|
|
|
|
|
} elsif ($var =~ /^#fun\d+$/) { |
5563
|
242
|
|
|
|
|
436
|
my ($f, $a, $b, $p) = @{$parser->{strmap}->{$var}}; |
|
242
|
|
|
|
|
751
|
|
5564
|
|
|
|
|
|
|
|
5565
|
|
|
|
|
|
|
# read with temporary varmap to simplify local variables |
5566
|
|
|
|
|
|
|
# (this should just run once per func) |
5567
|
|
|
|
|
|
|
# (keep globals in functions untouched until function is called) |
5568
|
|
|
|
|
|
|
# |
5569
|
242
|
100
|
|
|
|
834
|
my $name = defined $f ? (exists $ctx->{class_scope} ? method_name($ctx->{class_scope}, lc($f)) : lc($f)) : '{closure}'; |
|
|
100
|
|
|
|
|
|
5570
|
242
|
|
|
|
|
630
|
my $ctx2 = $ctx->simplification_ctx(infunction => $name); |
5571
|
|
|
|
|
|
|
|
5572
|
|
|
|
|
|
|
# invalidate function params for simplification |
5573
|
|
|
|
|
|
|
# |
5574
|
242
|
100
|
|
|
|
822
|
if (scalar @$a > 0) { |
5575
|
106
|
|
|
|
|
334
|
foreach my $v (@$a) { |
5576
|
111
|
100
|
|
|
|
398
|
if (is_variable($v)) { |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
5577
|
107
|
|
|
|
|
379
|
$ctx2->setvar($v, "#unresolved", 0); |
5578
|
|
|
|
|
|
|
} elsif ($v =~ /^#expr\d+$/) { |
5579
|
2
|
|
|
|
|
4
|
my ($op, $v1, $v2) = @{$parser->{strmap}->{$v}}; |
|
2
|
|
|
|
|
9
|
|
5580
|
2
|
50
|
33
|
|
|
14
|
if (($op eq '=') && is_variable($v1)) { |
5581
|
2
|
|
|
|
|
7
|
$ctx2->setvar($v1, "#unresolved", 0); |
5582
|
|
|
|
|
|
|
} |
5583
|
|
|
|
|
|
|
} elsif ($v =~ /^#ref\d+$/) { |
5584
|
2
|
|
|
|
|
8
|
my $r = $parser->{strmap}->{$v}->[0]; |
5585
|
2
|
50
|
|
|
|
7
|
if (is_variable($r)) { |
5586
|
2
|
|
|
|
|
17
|
$ctx2->setvar($r, "#unresolved", 0); |
5587
|
|
|
|
|
|
|
} |
5588
|
|
|
|
|
|
|
} |
5589
|
|
|
|
|
|
|
} |
5590
|
|
|
|
|
|
|
} |
5591
|
242
|
|
|
|
|
607
|
my $b2 = $ctx2->exec_statement($b); |
5592
|
|
|
|
|
|
|
|
5593
|
242
|
100
|
|
|
|
960
|
if (!is_block($b2)) { |
5594
|
2
|
|
|
|
|
9
|
$b2 = $parser->setblk('std', [$b2]); |
5595
|
|
|
|
|
|
|
} |
5596
|
|
|
|
|
|
|
|
5597
|
|
|
|
|
|
|
# copy static function variables into live context |
5598
|
|
|
|
|
|
|
# |
5599
|
242
|
|
|
|
|
359
|
foreach my $sf (keys %{$ctx2->{varmap}{static}}) { |
|
242
|
|
|
|
|
918
|
|
5600
|
169
|
|
|
|
|
315
|
foreach my $sv (keys %{$ctx2->{varmap}{static}{$sf}}) { |
|
169
|
|
|
|
|
589
|
|
5601
|
2
|
|
|
|
|
9
|
$ctx->{varmap}{static}{$sf}{$sv} = $ctx2->{varmap}{static}{$sf}{$sv}; |
5602
|
2
|
50
|
|
|
|
8
|
$ctx->{log}->($ctx, 'exec', $var, "register static var $sv in func $sf") if $ctx->{log}; |
5603
|
|
|
|
|
|
|
} |
5604
|
|
|
|
|
|
|
} |
5605
|
242
|
100
|
|
|
|
591
|
if ($b2 ne $b) { |
5606
|
70
|
|
|
|
|
274
|
my $k = $parser->setfun($f, $a, $b2, $p); |
5607
|
70
|
100
|
|
|
|
204
|
if (defined $f) { |
5608
|
69
|
|
|
|
|
195
|
$ctx->registerfun($f, $k); |
5609
|
|
|
|
|
|
|
} |
5610
|
70
|
|
|
|
|
540
|
return $k; |
5611
|
|
|
|
|
|
|
} |
5612
|
172
|
100
|
100
|
|
|
870
|
if (defined $f && !$ctx->getfun($f)) { |
5613
|
|
|
|
|
|
|
# allow local functions also for block simplify |
5614
|
|
|
|
|
|
|
# |
5615
|
18
|
50
|
|
|
|
104
|
$ctx->{log}->($ctx, 'exec', $var, "register local func $var [$f]") if $ctx->{log}; |
5616
|
18
|
|
|
|
|
49
|
$ctx->registerfun($f, $var); |
5617
|
|
|
|
|
|
|
} |
5618
|
|
|
|
|
|
|
} elsif ($var =~ /^#class\d+$/) { |
5619
|
56
|
|
|
|
|
84
|
my ($c, $b, $p) = @{$parser->{strmap}->{$var}}; |
|
56
|
|
|
|
|
173
|
|
5620
|
56
|
|
|
|
|
88
|
my ($type, $arglist) = @{$parser->{strmap}->{$b}}; |
|
56
|
|
|
|
|
144
|
|
5621
|
56
|
50
|
|
|
|
123
|
my $name = defined $c ? $c : 'class@anonymous'; |
5622
|
|
|
|
|
|
|
|
5623
|
56
|
|
|
|
|
175
|
$ctx->{varmap}{inst}{lc($c)} = {}; # init class var map |
5624
|
|
|
|
|
|
|
|
5625
|
|
|
|
|
|
|
# init class properties here |
5626
|
|
|
|
|
|
|
# https://www.php.net/manual/en/language.oop5.properties.php |
5627
|
|
|
|
|
|
|
# |
5628
|
56
|
|
|
|
|
105
|
my @args = (); |
5629
|
56
|
|
|
|
|
98
|
my $changed = 0; |
5630
|
56
|
|
|
|
|
105
|
foreach my $a (@$arglist) { |
5631
|
94
|
100
|
|
|
|
372
|
if ($a =~ /^#fun\d+$/) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
5632
|
|
|
|
|
|
|
# function bodies are replaced inplace |
5633
|
47
|
|
|
|
|
180
|
my $ctx2 = $ctx->subscope_ctx(varmap => {}, class_scope => lc($name), infunction => 0); |
5634
|
47
|
|
|
|
|
165
|
my $f = $ctx2->exec_statement($a, 1); |
5635
|
47
|
|
|
|
|
115
|
push(@args, $f); |
5636
|
47
|
100
|
|
|
|
219
|
if ($f ne $a) { |
5637
|
16
|
|
|
|
|
77
|
$changed = 1; |
5638
|
|
|
|
|
|
|
} |
5639
|
|
|
|
|
|
|
} elsif (($a =~ /^#expr\d+$/)) { |
5640
|
9
|
|
|
|
|
15
|
my ($op, $o1, $o2) = @{$parser->{strmap}->{$a}}; |
|
9
|
|
|
|
|
29
|
|
5641
|
9
|
|
|
|
|
39
|
my $ctx2 = $ctx->subscope_ctx(varmap => {}, class_scope => lc($name), infunction => 0); |
5642
|
9
|
50
|
|
|
|
41
|
if ($op eq '=') { |
5643
|
9
|
|
|
|
|
33
|
my $k = $ctx2->exec_statement($a, 1); |
5644
|
9
|
|
|
|
|
60
|
push(@args, $k); |
5645
|
|
|
|
|
|
|
} |
5646
|
|
|
|
|
|
|
} elsif ($a =~ /^#stmt\d+$/) { |
5647
|
13
|
|
|
|
|
34
|
my $cmd = $parser->{strmap}->{$a}->[0]; |
5648
|
13
|
|
|
|
|
49
|
my $ctx2 = $ctx->subscope_ctx(varmap => {}, class_scope => lc($name), infunction => 0); |
5649
|
13
|
100
|
|
|
|
56
|
if ($cmd eq 'static') { |
|
|
50
|
|
|
|
|
|
5650
|
9
|
|
|
|
|
34
|
my $k = $ctx2->exec_statement($a, 1); |
5651
|
9
|
|
|
|
|
52
|
push(@args, $k); |
5652
|
|
|
|
|
|
|
} elsif ($cmd eq 'const') { |
5653
|
4
|
|
|
|
|
23
|
my $k = $ctx2->exec_statement($a, 1); |
5654
|
4
|
|
|
|
|
29
|
push(@args, $k); |
5655
|
|
|
|
|
|
|
} |
5656
|
|
|
|
|
|
|
} else { |
5657
|
25
|
|
|
|
|
52
|
push(@args, $a); |
5658
|
|
|
|
|
|
|
} |
5659
|
|
|
|
|
|
|
} |
5660
|
56
|
100
|
|
|
|
120
|
if ($changed) { |
5661
|
13
|
|
|
|
|
50
|
my $b2 = $parser->setblk('std', \@args); |
5662
|
13
|
|
|
|
|
74
|
my $k = $parser->setclass($c, $b2, $p); |
5663
|
13
|
|
|
|
|
43
|
$ctx->registerclass($c, $k); |
5664
|
13
|
|
|
|
|
38
|
return $k; |
5665
|
|
|
|
|
|
|
} |
5666
|
43
|
100
|
66
|
|
|
150
|
if (defined $c && !$ctx->getclass($c)) { |
5667
|
2
|
50
|
|
|
|
11
|
$ctx->{log}->($ctx, 'exec', $var, "register local class $var [$c]") if $ctx->{log}; |
5668
|
2
|
|
|
|
|
11
|
$ctx->registerclass($c, $var); |
5669
|
|
|
|
|
|
|
} |
5670
|
|
|
|
|
|
|
} else { |
5671
|
1
|
|
|
|
|
6
|
$ctx->{warn}->($ctx, 'exec', $var, "skip"); |
5672
|
|
|
|
|
|
|
} |
5673
|
219
|
|
|
|
|
546
|
return $var; |
5674
|
|
|
|
|
|
|
} |
5675
|
|
|
|
|
|
|
|
5676
|
|
|
|
|
|
|
# track variable assignments in expressions (optionally reinsert them later) |
5677
|
|
|
|
|
|
|
# |
5678
|
|
|
|
|
|
|
sub track_assignment { |
5679
|
456
|
|
|
456
|
0
|
951
|
my ($ctx, $var, $val) = @_; |
5680
|
|
|
|
|
|
|
|
5681
|
456
|
|
|
|
|
1471
|
$ctx->{varhist}{$var} = [$val, $histidx++]; |
5682
|
456
|
|
|
|
|
853
|
return; |
5683
|
|
|
|
|
|
|
} |
5684
|
|
|
|
|
|
|
|
5685
|
|
|
|
|
|
|
sub discard_pending_assignments { |
5686
|
17
|
|
|
17
|
0
|
41
|
my ($ctx) = @_; |
5687
|
17
|
|
|
|
|
47
|
$ctx->{varhist} = {}; |
5688
|
17
|
|
|
|
|
63
|
return; |
5689
|
|
|
|
|
|
|
} |
5690
|
|
|
|
|
|
|
|
5691
|
|
|
|
|
|
|
sub have_assignments { |
5692
|
2
|
|
|
2
|
0
|
6
|
my ($ctx) = @_; |
5693
|
|
|
|
|
|
|
|
5694
|
2
|
50
|
|
|
|
4
|
if (scalar keys %{$ctx->{varhist}} > 0) { |
|
2
|
|
|
|
|
8
|
|
5695
|
0
|
|
|
|
|
0
|
return 1; |
5696
|
|
|
|
|
|
|
} |
5697
|
2
|
|
|
|
|
5
|
return 0; |
5698
|
|
|
|
|
|
|
} |
5699
|
|
|
|
|
|
|
|
5700
|
|
|
|
|
|
|
sub insert_assignments { |
5701
|
3058
|
|
|
3058
|
0
|
5840
|
my ($ctx, $stmt) = @_; |
5702
|
3058
|
|
|
|
|
5009
|
my $parser = $ctx->{parser}; |
5703
|
|
|
|
|
|
|
|
5704
|
3058
|
100
|
|
|
|
4322
|
if (scalar keys %{$ctx->{varhist}} > 0) { |
|
3058
|
|
|
|
|
9262
|
|
5705
|
|
|
|
|
|
|
# add assignments in exec-order |
5706
|
|
|
|
|
|
|
# |
5707
|
395
|
|
|
|
|
813
|
my @blk = (); |
5708
|
395
|
|
|
|
|
729
|
my @ass = (); |
5709
|
395
|
|
|
|
|
677
|
foreach my $v (sort { $ctx->{varhist}{$a}->[1] <=> $ctx->{varhist}{$b}->[1] } keys %{$ctx->{varhist}}) { |
|
24
|
|
|
|
|
122
|
|
|
395
|
|
|
|
|
1467
|
|
5710
|
417
|
0
|
|
|
|
966
|
$ctx->{log}->($ctx, 'assign', defined $stmt ? $stmt : '[]', "$v = $ctx->{varhist}{$v}->[0]") if $ctx->{log}; |
|
|
50
|
|
|
|
|
|
5711
|
|
|
|
|
|
|
|
5712
|
417
|
100
|
|
|
|
1008
|
if ($ctx->{varhist}{$v}->[0] ne '#unresolved') { |
5713
|
305
|
|
|
|
|
431
|
my $e; |
5714
|
305
|
100
|
|
|
|
1033
|
if ($v =~ /^\$eval\$/) { |
5715
|
|
|
|
|
|
|
# eval blocks are inserted at front before assignments |
5716
|
|
|
|
|
|
|
# |
5717
|
218
|
|
|
|
|
468
|
$e = $ctx->{varhist}{$v}->[0]; # eval block |
5718
|
218
|
100
|
|
|
|
608
|
if (is_block($e)) { |
5719
|
157
|
|
|
|
|
459
|
$parser->flatten_block($e, \@blk); |
5720
|
|
|
|
|
|
|
} else { |
5721
|
61
|
|
|
|
|
178
|
push(@blk, $e); |
5722
|
|
|
|
|
|
|
} |
5723
|
|
|
|
|
|
|
} else { |
5724
|
|
|
|
|
|
|
# assignments are inserted at front |
5725
|
|
|
|
|
|
|
# |
5726
|
87
|
|
|
|
|
342
|
$e = $parser->setexpr('=', $v, $ctx->{varhist}{$v}->[0]); |
5727
|
87
|
|
|
|
|
261
|
push(@ass, $e); |
5728
|
|
|
|
|
|
|
} |
5729
|
|
|
|
|
|
|
} |
5730
|
|
|
|
|
|
|
} |
5731
|
395
|
100
|
100
|
|
|
1678
|
if ((scalar @ass > 0) || (scalar @blk > 0)) { |
5732
|
193
|
100
|
|
|
|
422
|
if (defined $stmt) { |
5733
|
165
|
|
|
|
|
466
|
$parser->flatten_block($stmt, \@ass); |
5734
|
|
|
|
|
|
|
} |
5735
|
193
|
|
|
|
|
707
|
$stmt = $parser->setblk('flat', [@blk, @ass]); |
5736
|
|
|
|
|
|
|
} |
5737
|
|
|
|
|
|
|
} |
5738
|
3058
|
|
|
|
|
8283
|
$ctx->{varhist} = {}; |
5739
|
3058
|
|
|
|
|
5823
|
return $stmt; |
5740
|
|
|
|
|
|
|
} |
5741
|
|
|
|
|
|
|
|
5742
|
|
|
|
|
|
|
1; |
5743
|
|
|
|
|
|
|
|
5744
|
|
|
|
|
|
|
__END__ |