RFC: Adding variable name to warning "Use of uninitialized value ??? in ..."

[LanX]

Just a hack as prove of concept for Re^4: determine the variable causing the error: Use of uninitialized value

Can be improved in different ways ...

Due to limitations of B::Deparse it's only working if warning happens within a subroutine.

use strict;
use warnings;
use Data::Dump qw/pp dd/;
use B::Deparse qw/coderef2text/;
use PadWalker  qw/peek_my/;


my %warncache;
my $result;

BEGIN {
    $SIG{__WARN__}
      = sub {
          my ($err)=@_;

          # ignore other warnings
          unless ($err =~ m/^(Use of uninitialized value) (in (\w+) .*
+)$/) {
              warn "$err";
              return;
          }

          # ignore other undef vars
          return if $warncache{$err}++;


          my ($msg_start, $msg_end, $msg_type) =($1,$2,$3);
          #warn "* OrigWarn:\t $err";

          my ($file,$line) = (caller(0))[1,2];
          my $subname      = (caller(1))[3];



          my ($subref,$subline) = get_subline($subname,$file,$line,$er
+r);

          #warn  "LINE:<$subline>";

          my $peek_sub = PadWalker::peek_sub ($subref);

          my $sep  =  {
              concatenation => '\\.',
              printf        => ',',
              sprintf       => ',',
          }->{$msg_type};

          my $chomp  =  {
              sprintf       => '\)',
          }->{$msg_type};

          $subline =~ s/$chomp$// if $chomp;

          my @split = split /\s*$sep\s*/, $subline;
          #dd [$subline, @split, $peek_sub];

          my @undefined;

          for my $snippet ( @split) {
              while ( my ($var,$ref) = each %$peek_sub){

                  $var =~ s/^\%/\$/;
                  $var =~ s/^\@/\$/;

                  my $match="\\$var";

                  if ( $snippet  =~ /^(.*?)($match)(.*)$/ ) {
                      my $new="$1\$ref$3";
                      #warn "match VAR <$match> in $snippet as $new";
                      next if defined eval($new);
                      #warn "UNDEF $snippet";
                      push @undefined, $snippet;
                  }
              }
          }

          #dd \@undefined;

          # build new warning
          my $plural = @undefined > 1 ? "s" :"";
          my $new_err = "${msg_start}$plural @undefined $msg_end";
          warn
            # ". NewWarn:\t".
            "$new_err\n";

          $result = {
              oldmsg => $err,
              newmsg => $new_err,
              vars   => [@undefined],
              line   => $subline,
              split  => [@split],
              peek   => $peek_sub,
          };
      };

}

sub get_subline {
    my ($name,$file,$line,$err) =@_;
    #dd \@_;

    my $subref = \&{$name};

    my $subbody = B::Deparse->new('-q','-l','-x0')->coderef2text($subr
+ef);


    my $start = "#line \Q$line\E \"\Q$file\E\"\n";


    my $end   = "\n(#line|})";

    #warn $subbody;

    #dd "match:", $subbody =~ m/($start)/;

    my ($subline) =
      $subbody =~ m/$start\s+(.*?);$end/s;

    return ($subref, $subline);
}

#warn "Version $]";

my %hash=(a=>undef,b=>[]);
my $h=\%hash;

my @array=({a=>undef});
my $a=\@array;




while (my $case = <DATA>) {
    chomp $case;
    next unless $case;
    next if $case =~ /^#/;

    my ($name,$var) = split /\s*:\s*/,$case;
    
    warn "*** TESTING".pp [$name,$var];
    no warnings 'redefine';
    my $out ="";
    open OUT,">",\$out;

    my @lines = (
        # one undef var
        qq#  print  OUT "$name: $var";             #,
        qq#  printf OUT '$name %s',$var;           #,
        qq#  print  OUT  sprintf '$name %s',$var;  #,

        # multiple undef vars
        qq#  print  OUT "$name: $var $var"                #,
        qq#  printf OUT '$name %s %s',$var,$var;           #,
        qq#  print  OUT sprintf '$name %s %s',$var,$var;  #,
       );

    for my $line (@lines) {
        my $code = <<"__CODE__";
          sub tst {
              $line
          };
__CODE__
        eval $code;
        if ($@) {
            warn "SKIPPING TEST $@ in \n<<<$code>>>";
            next;
            
        }

        undef $result;
        tst();
        
        die "$case", pp $result  if $result and
            not  @{$result->{vars}};
        #warn pp $code,$result;  
    }



    #last;

}



exit;

__DATA__

hash_ref: $h->{a}
hoa_ref:  $h->{b}[0]

hash:     $hash{a}
hoa:      $hash{b}[0]

array:    $array[1]
aoh:      $array[0]{a}

array_ref:$a->[1]
aoh_ref:  $a->[0]{a}

#aoh_ref:  $a->[$b]{'a  b'}

Output:

Name "main::OUT" used only once: possible typo at /home/lanx/pm/warn_u
+ndef.pl line 141.
*** TESTING["hash_ref", "\$h->{a}"] at /home/lanx/pm/warn_undef.pl lin
+e 138, <DATA> line 2.
Use of uninitialized value $$h{'a'} in concatenation (.) or string at 
+(eval 10) line 2, <DATA> line 2.
Use of uninitialized value $$h{'a'} in printf at (eval 12) line 2, <DA
+TA> line 2.
Use of uninitialized value $$h{'a'} in sprintf at (eval 14) line 2, <D
+ATA> line 2.
Use of uninitialized values $$h{'a'} $$h{'a'} in concatenation (.) or 
+string at (eval 16) line 2, <DATA> line 2.
Use of uninitialized values $$h{'a'} $$h{'a'} in printf at (eval 19) l
+ine 2, <DATA> line 2.
Use of uninitialized values $$h{'a'} $$h{'a'} in sprintf at (eval 22) 
+line 2, <DATA> line 2.
*** TESTING["hoa_ref", "\$h->{b}[0]"] at /home/lanx/pm/warn_undef.pl l
+ine 138, <DATA> line 3.
Use of uninitialized value $$h{'b'}[0] in concatenation (.) or string 
+at (eval 25) line 2, <DATA> line 3.
Use of uninitialized value $$h{'b'}[0] in printf at (eval 27) line 2, 
+<DATA> line 3.
Use of uninitialized value $$h{'b'}[0] in sprintf at (eval 29) line 2,
+ <DATA> line 3.
Use of uninitialized values $$h{'b'}[0] $$h{'b'}[0] in concatenation (
+.) or string at (eval 31) line 2, <DATA> line 3.
Use of uninitialized values $$h{'b'}[0] $$h{'b'}[0] in printf at (eval
+ 34) line 2, <DATA> line 3.
Use of uninitialized values $$h{'b'}[0] $$h{'b'}[0] in sprintf at (eva
+l 37) line 2, <DATA> line 3.
*** TESTING["hash", "\$hash{a}"] at /home/lanx/pm/warn_undef.pl line 1
+38, <DATA> line 5.
Use of uninitialized value $hash{"a"} in concatenation (.) or string a
+t (eval 40) line 2, <DATA> line 5.
Use of uninitialized value $hash{"a"} in printf at (eval 41) line 2, <
+DATA> line 5.
Use of uninitialized value $hash{"a"} in sprintf at (eval 42) line 2, 
+<DATA> line 5.
Use of uninitialized value $hash{"a"} in concatenation (.) or string a
+t (eval 43) line 2, <DATA> line 5.
Use of uninitialized value $hash{"a"} in concatenation (.) or string a
+t (eval 43) line 2, <DATA> line 5.
Use of uninitialized value $hash{"a"} in printf at (eval 44) line 2, <
+DATA> line 5.
Use of uninitialized value $hash{"a"} in printf at (eval 44) line 2, <
+DATA> line 5.
Use of uninitialized value $hash{"a"} in sprintf at (eval 45) line 2, 
+<DATA> line 5.
Use of uninitialized value $hash{"a"} in sprintf at (eval 45) line 2, 
+<DATA> line 5.
*** TESTING["hoa", "\$hash{b}[0]"] at /home/lanx/pm/warn_undef.pl line
+ 138, <DATA> line 6.
Use of uninitialized value $hash{'b'}[0] in concatenation (.) or strin
+g at (eval 46) line 2, <DATA> line 6.
Use of uninitialized value $hash{'b'}[0] in printf at (eval 48) line 2
+, <DATA> line 6.
Use of uninitialized value $hash{'b'}[0] in sprintf at (eval 50) line 
+2, <DATA> line 6.
Use of uninitialized values $hash{'b'}[0] $hash{'b'}[0] in concatenati
+on (.) or string at (eval 52) line 2, <DATA> line 6.
Use of uninitialized values $hash{'b'}[0] $hash{'b'}[0] in printf at (
+eval 55) line 2, <DATA> line 6.
Use of uninitialized values $hash{'b'}[0] $hash{'b'}[0] in sprintf at 
+(eval 58) line 2, <DATA> line 6.
*** TESTING["array", "\$array[1]"] at /home/lanx/pm/warn_undef.pl line
+ 138, <DATA> line 8.
Use of uninitialized value $array[1] in concatenation (.) or string at
+ (eval 61) line 2, <DATA> line 8.
Use of uninitialized value $array[1] in printf at (eval 62) line 2, <D
+ATA> line 8.
Use of uninitialized value $array[1] in sprintf at (eval 64) line 2, <
+DATA> line 8.
Use of uninitialized value $array[1] in concatenation (.) or string at
+ (eval 65) line 2, <DATA> line 8.
Use of uninitialized values $array[1] $array[1] in concatenation (.) o
+r string at (eval 65) line 2, <DATA> line 8.
Use of uninitialized values $array[1] $array[1] in printf at (eval 68)
+ line 2, <DATA> line 8.
Use of uninitialized values $array[1] $array[1] in sprintf at (eval 71
+) line 2, <DATA> line 8.
*** TESTING["aoh", "\$array[0]{a}"] at /home/lanx/pm/warn_undef.pl lin
+e 138, <DATA> line 9.
Use of uninitialized value $array[0]{'a'} in concatenation (.) or stri
+ng at (eval 74) line 2, <DATA> line 9.
Use of uninitialized value $array[0]{'a'} in printf at (eval 76) line 
+2, <DATA> line 9.
Use of uninitialized value $array[0]{'a'} in sprintf at (eval 78) line
+ 2, <DATA> line 9.
Use of uninitialized values $array[0]{'a'} $array[0]{'a'} in concatena
+tion (.) or string at (eval 80) line 2, <DATA> line 9.
Use of uninitialized values $array[0]{'a'} $array[0]{'a'} in printf at
+ (eval 83) line 2, <DATA> line 9.
Use of uninitialized values $array[0]{'a'} $array[0]{'a'} in sprintf a
+t (eval 86) line 2, <DATA> line 9.
*** TESTING["array_ref", "\$a->[1]"] at /home/lanx/pm/warn_undef.pl li
+ne 138, <DATA> line 11.
Use of uninitialized value $$a[1] in concatenation (.) or string at (e
+val 89) line 2, <DATA> line 11.
Use of uninitialized value $$a[1] in printf at (eval 91) line 2, <DATA
+> line 11.
Use of uninitialized value $$a[1] in sprintf at (eval 93) line 2, <DAT
+A> line 11.
Use of uninitialized values $$a[1] $$a[1] in concatenation (.) or stri
+ng at (eval 95) line 2, <DATA> line 11.
Use of uninitialized values $$a[1] $$a[1] in printf at (eval 98) line 
+2, <DATA> line 11.
Use of uninitialized values $$a[1] $$a[1] in sprintf at (eval 101) lin
+e 2, <DATA> line 11.
*** TESTING["aoh_ref", "\$a->[0]{a}"] at /home/lanx/pm/warn_undef.pl l
+ine 138, <DATA> line 12.
Use of uninitialized value $$a[0]{'a'} in concatenation (.) or string 
+at (eval 104) line 2, <DATA> line 12.
Use of uninitialized value $$a[0]{'a'} in printf at (eval 106) line 2,
+ <DATA> line 12.
Use of uninitialized value $$a[0]{'a'} in sprintf at (eval 108) line 2
+, <DATA> line 12.
Use of uninitialized values $$a[0]{'a'} $$a[0]{'a'} in concatenation (
+.) or string at (eval 110) line 2, <DATA> line 12.
Use of uninitialized values $$a[0]{'a'} $$a[0]{'a'} in printf at (eval
+ 113) line 2, <DATA> line 12.
Use of uninitialized values $$a[0]{'a'} $$a[0]{'a'} in sprintf at (eva
+l 116) line 2, <DATA> line 12.

[dave_the_m]

My implementation in the perl core was a compromise between complexity, performance and convenience. It's currently about 750 lines of src code. It could certainly be expanded to extract the variable name under more circumstances, but I had to draw a line somewhere.

Note also that it's quite hard to avoid false positives. For example, for an empty array @a, in $a[0] + $a[1] at the time of execution of the addition, both args are the same special address &PL_sv_undef, so its not possible to determine whether a particular undef value came from the LHS or the RHS.

Dave.

[LanX]

Hi Dave

Thanks for the feedback :)

> My implementation in the perl core was a compromise between complexity, performance and convenience. 

I know, and this is in no way a criticism of your implementation! I'm aware of the complexity.

I want to open an opportunity to better inspect problems in pure Perl.

At work we are using many here docs and help in faster identifying root problems would be appreciated.

See it as a potential add on module like diagnostics and not as a feature request for core.

> It's currently about 750 lines of src code. It could certainly be expanded to extract the variable name under more circumstances, but I had to draw a line somewhere.

That's why I'm delegating the hard part to B::Deparse

> Note also that it's quite hard to avoid false positives

That's why I'm reporting all potential culprits with undef values in the first warning and ignoring all other warnings from the same line.

I don't want to risk that a true positive gets lost because of a false positive.

It's up to the user to find out which are real.

[LanX]

Brainstorm:

To Do

• cover more cases , not only concatenation , printf and sprintf , like addition and join . (...where do I find a complete list?)
• test false positives
• make SIG handler collaborating with older hooks, like for diagnostics
• test package variables
• test global variables ,symbols, barewords
• cover slices like @a[0..2]
• test with different Perl versions in perlbrew
• handle call from filescope and eval
* 17.4.2017
• handle multiple statements in same line

Nice to Have

• report original source line too
• patch B::Deparse instead of parsing string output
• add hooks for further customization by user
• handle tied variables