Почему в этом предупреждающем сообщении Perl вводит неверный номер строки?

Question

Я выделил случай, когда Perl вводит в заблуждение очень вводящий в заблуждение номер строки.Я протестировал нижеприведенное в Strawberry Perl 5.16.3.

use strict;
use warnings;

my $choice = 0;

while ($choice == 0){

    #This is not numeric
    $choice = '5,6,7';

    if ($choice eq '-4'){
        print "This isn't going to happen\n";
    }
}

Когда вы запустите это, вы получите предупреждение Argument "5,6,7" isn't numeric in numeric eq (==) at example.pl line 11.Но строка 11 соответствует строке if ($choice eq '-4'){, которая не может вызвать это предупреждающее сообщение, поскольку она не содержит числового сравнения.

Кажется, что на самом деле происходит в том, что Perl переходит к следующемусравнение, while ($choice == 0){, но счетчик строк, используемый для предупреждающего сообщения, не продвигается.

Что еще хуже усугубляет этот конкретный случай, так как "плохое" сравнение является условием цикла, оно на самом деле далекос предоставленной линии.В моем сценарии (до упрощения) он находился на расстоянии сотен строк от предоставленного номера строки.

Это ошибка или просто неудачное ограничение синтаксического анализатора?

Answer 1

Очевидно, начиная с Perl 5.008, интерпретатор начал опускать код операции, позволяющий интерпретатору узнать текущий номер строки.

Используя минималистский скрипт:

while ($choice == 0) {
    $choice = '5,6,7';
}

Мы получаем этот выводиз Perl 5.6 и B::Concise:

$ perl506 -MO=Concise badwarnline.pl
f  <@> leave[t1] vKP/REFC ->(end)
1     <0> enter ->2
2     <;> nextstate(main 2 badwarnline.pl:1) v ->3
e     <2> leaveloop vK/2 ->f
3        <{> enterloop(next->8 last->e redo->4) v ->a
-        <1> null vK/1 ->e
d           <|> and(other->4) vK/1 ->e
c              <2> eq sK/2 ->d
-                 <1> ex-rv2sv sK/1 ->b
a                    <$> gvsv(*choice) s ->b
b                 <$> const(IV 0) s ->c
-              <@> lineseq vKP ->-
4                 <;> nextstate(main 1 badwarnline.pl:2) v ->5
7                 <2> sassign vKS/2 ->8
5                    <$> const(PV "5,6,7") s ->6
-                    <1> ex-rv2sv sKRM*/1 ->7
6                       <$> gvsv(*choice) s ->7
8                 <0> unstack v ->9
9                 <;> nextstate(main 2 badwarnline.pl:1) v ->a

и этот выход из Perl v5.008:

$ perl508 -MO=Concise badwarnline.pl
e  <@> leave[1 ref] vKP/REFC ->(end)
1     <0> enter ->2
2     <;> nextstate(main 2 badwarnline.pl:1) v ->3
d     <2> leaveloop vK/2 ->e
3        <{> enterloop(next->8 last->d redo->4) v ->9
-        <1> null vK/1 ->d
c           <|> and(other->4) vK/1 ->d
b              <2> eq sK/2 ->c
-                 <1> ex-rv2sv sK/1 ->a
9                    <#> gvsv[*choice] s ->a
a                 <$> const[IV 0] s ->b
-              <@> lineseq vKP ->-
4                 <;> nextstate(main 1 badwarnline.pl:2) v ->5
7                 <2> sassign vKS/2 ->8
5                    <$> const[PV "5,6,7"] s ->6
-                    <1> ex-rv2sv sKRM*/1 ->7
6                       <#> gvsv[*choice] s ->7
8                 <0> unstack v ->9

Основное различие между этими выходами - последнеестрока, произведенная 5.006:

9                 <;> nextstate(main 2 badwarnline.pl:1) v ->a

, которая отсутствует в выводе 5.008.

Answer 2

Это не столько решение, сколько способ найти решение, если кто-то захочет поработать над ним.

Было бы дорого хранить местоположение каждого экземпляра оператора.В качестве компромисса,

Недавняя работа, которую я выполнял при разборе во время выполнения, уменьшает необходимость добавлять дополнительные места в дереве.

Для этого примера с Devel :: Trepan :: Deparse вот что вы получите:

(trepanpl): disasm
Package Main
------------
    #4: my $choice = 0;
        COP (0x195a0b0) dbstate 
        BINOP (0x195a110) sassign 
=>          SVOP (0x195a158) const  IV (0x1953f68) 0 
            OP (0x195a198) padsv [1] 
    #6: while ($choice == 0){
        COP (0x1b5b070) dbstate 
        BINOP (0x1b5b0d0) leaveloop 
            LOOP (0x1b5b118) enterloop 
            UNOP (0x1b5b178) null 
                LOGOP (0x1b5b1b8) and 
                    BINOP (0x195a850) eq <<< This is where the error is
                        OP (0x195a000) padsv [1] 
                        SVOP (0x195a898) const  IV (0x1953fb0) 0 
                    LISTOP (0x195a6e8) lineseq 
    #9:     $choice = '5,6,7';
            COP (0x2459530) dbstate 
            BINOP (0x2459590) sassign 
                SVOP (0x24595d8) const  PV (0x2da5ae0) "5,6,7" 
                OP (0x21e8618) padsv [1] 
... 
(trepanpl): deparse 0x195a850
binary operator ==, eq    
while ($choice == 0)  {
       ------------

А если вы добавите другие смещения, вы получите другие варианты.Например,

(trepanpl): deparse 0x195a000
not my, padsv 
while ($choice == 0)  {
       -------
(trepanpl): deparse 0x21e8618
not my, padsv 
$choice = '5,6,7';
-------

Обратите внимание, что вы получаете не только текст строки, но и место, где в строке возникла проблема.Если бы код был

while ($choice == 0 && $i_feel_pretty == 3) 

, то отмена указала бы, в каком из двух условий возникла проблема, даже если они оба находятся в одной строке.

Итак, нужно получить адрес OP при появлении предупреждения или ошибки, а затем вызвать B :: DeparseTree , чтобы сообщить о местоположении и контексте.

В настоящее времяPerl предоставляет $SIG{__WARN__} и $SIG{__DIE__}, но значение PL_op недоступно во время вызова обработчика, даже если обработчик является подпрограммой XS.PL_op сохраняется, затем устанавливается на поддельное OP_ENTERSUB a для вызова обработчика.

Однако есть надежда, что решение этой проблемы может быть выполнено быстрее, чем исправление этой ошибки, существовавшей в течение 16 лет.лет, и я сомневаюсь, что это будет решено в ближайшее время.См. perl # 133239 .

Наконец, я скажу, что прямо сейчас B :: DeparseTree не возвращается к 5.16 и код вообще нуждается в большей любвичем я могу дать это сам.

Answer 3

Было бы дорого хранить местоположение каждого экземпляра оператора.В качестве компромисса Perl отслеживает только расположение операторов.Это делается путем добавления кода операции установки местоположения в начале каждого оператора.Оператор if является последним оператором, который должен быть запущен перед выполнением $choice == 0, поэтому предупреждение поступает из этой строки.

$ perl -MO=Concise,-exec a.pl
1  <0> enter
2  <;> nextstate(main 3 a.pl:4) v:*,&,{,x*,x&,x$,$
3  <$> const[IV 0] s
4  <0> padsv[$choice:3,12] sRM*/LVINTRO
5  <2> sassign vKS/2
6  <;> nextstate(main 4 a.pl:6) v:*,&,{,x*,x&,x$,$           <--- Location set to line 6
7  <{> enterloop(next->k last->p redo->8) v                  <--- Start of while loop
l  <0> padsv[$choice:3,12] s                                 <--- $choice == 0
m  <$> const[IV 0] s
n  <2> eq sK/2
o  <|> and(other->8) vK/1
8      <;> nextstate(main 6 a.pl:9) v:*,&,x*,x&,x$,$
9      <$> const[PV "5,6,7"] s
a      <0> padsv[$choice:3,12] sRM*
b      <2> sassign vKS/2
c      <;> nextstate(main 6 a.pl:11) v:*,&,x*,x&,x$,$        <--- Location set to line 11
d      <0> padsv[$choice:3,12] s                             <--- Start of if statement
e      <$> const[PV "-4"] s
f      <2> seq sK/2
g      <|> and(other->h) vK/1
h          <0> pushmark s
i          <$> const[PV "This isn't going to happen\n"] s
j          <@> print vK
k      <0> unstack v
           goto l                                            <--- Jump back to loop expr
p  <2> leaveloop vKP/2
q  <@> leave[1 ref] vKP/REFC
a.pl syntax OK

Это известное ограничение.Я не знаю, почему они просто не помещают nextstate op в выражение цикла.