This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Another patch for Lexical Warnings
authorPaul Marquess <paul.marquess@btinternet.com>
Sun, 5 Sep 1999 15:11:08 +0000 (16:11 +0100)
committerGurusamy Sarathy <gsar@cpan.org>
Mon, 6 Sep 1999 18:52:10 +0000 (18:52 +0000)
Message-ID: <5104D4DBC598D211B5FE0000F8FE7EB202D49BAB@mbtlipnt02.btlabs.bt.co.uk>

p4raw-id: //depot/perl@4088

12 files changed:
pp_sys.c
t/pragma/warn/doio
t/pragma/warn/op
t/pragma/warn/pp_hot
t/pragma/warn/pp_sys
t/pragma/warn/regcomp
t/pragma/warn/sv
t/pragma/warn/toke
t/pragma/warn/universal
t/pragma/warn/utf8
t/pragma/warn/util
toke.c

index 6c80e5e..fd0ba8c 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -1565,8 +1565,8 @@ PP(pp_sysread)
            length = -1;
     }
     if (length < 0) {
            length = -1;
     }
     if (length < 0) {
-       if (IoTYPE(io) == '>' || IoIFP(io) == PerlIO_stdout()
-           || IoIFP(io) == PerlIO_stderr())
+       if ((IoTYPE(io) == '>' || IoIFP(io) == PerlIO_stdout()
+           || IoIFP(io) == PerlIO_stderr()) && ckWARN(WARN_IO))
        {
            SV* sv = sv_newmortal();
            gv_efullname3(sv, gv, Nullch);
        {
            SV* sv = sv_newmortal();
            gv_efullname3(sv, gv, Nullch);
index e6de782..5101bde 100644 (file)
@@ -1,60 +1,62 @@
-  doio.c       AOK
+  doio.c       
 
 
-  Can't do bidirectional pipe
+  Can't do bidirectional pipe          [Perl_do_open9]
     open(F, "| true |");
 
     open(F, "| true |");
 
-  Missing command in piped open
+  Missing command in piped open                [Perl_do_open9]
     open(F, "| ");
 
     open(F, "| ");
 
-  Missing command in piped open
+  Missing command in piped open                [Perl_do_open9]
     open(F, " |");
 
     open(F, " |");
 
-  warn(warn_nl, "open");
+  warn(warn_nl, "open");               [Perl_do_open9]
     open(F, "true\ncd")
 
     open(F, "true\ncd")
 
-  Close on unopened file <%s>
-    $a = "fred";close($a)
+  Close on unopened file <%s>          [Perl_do_close] <<TODO
+    $a = "fred";close("$a")
 
 
-  tell() on unopened file
+  tell() on unopened file              [Perl_do_tell]
     $a = "fred";$a = tell($a)
 
     $a = "fred";$a = tell($a)
 
-  seek() on unopened file
+  seek() on unopened file              [Perl_do_seek]
     $a = "fred";$a = seek($a,1,1)
 
     $a = "fred";$a = seek($a,1,1)
 
-  sysseek() on unopened file
+  sysseek() on unopened file           [Perl_do_sysseek]
     $a = "fred";$a = seek($a,1,1)
 
     $a = "fred";$a = seek($a,1,1)
 
-  warn(warn_uninit);
+  warn(warn_uninit);                   [Perl_do_print]
     print $a ;
 
     print $a ;
 
-  Stat on unopened file <%s> 
+  Stat on unopened file <%s>           [Perl_my_stat]
     close STDIN ; -x STDIN ;
 
     close STDIN ; -x STDIN ;
 
-  warn(warn_nl, "stat");
+  warn(warn_nl, "stat");               [Perl_my_stat]
     stat "ab\ncd"
 
     stat "ab\ncd"
 
-  warn(warn_nl, "lstat");
+  warn(warn_nl, "lstat");              [Perl_my_lstat]
     lstat "ab\ncd"
 
     lstat "ab\ncd"
 
-  Can't exec \"%s\": %s 
+  Can't exec \"%s\": %s                [Perl_do_aexec5]
 
 
-  Can't exec \"%s\": %s 
+  Can't exec \"%s\": %s                [Perl_do_exec3]
 
 
+  Filehandle %s opened only for output [Perl_do_eof]
+       my $a = eof STDOUT
 
   Mandatory Warnings ALL TODO
   ------------------
 
   Mandatory Warnings ALL TODO
   ------------------
-  Can't do inplace edit: %s is not a regular file
+  Can't do inplace edit: %s is not a regular file      [Perl_nextargv]
      edit a directory
 
      edit a directory
 
-  Can't do inplace edit: %s would not be unique
-  Can't rename %s to %s: %s, skipping file
-  Can't rename %s to %s: %s, skipping file
-  Can't remove %s: %s, skipping file
-  Can't do inplace edit on %s: %s
+  Can't do inplace edit: %s would not be unique                [Perl_nextargv]
+  Can't rename %s to %s: %s, skipping file             [Perl_nextargv]
+  Can't rename %s to %s: %s, skipping file             [Perl_nextargv]
+  Can't remove %s: %s, skipping file                   [Perl_nextargv]
+  Can't do inplace edit on %s: %s                      [Perl_nextargv]
   
 
 __END__
   
 
 __END__
-# doio.c
+# doio.c [Perl_do_open9]
 use warnings 'io' ;
 open(F, '|'.($^O eq 'VMS' ? 'mcr ':'')."$^X -e 1|");
 close(F);
 use warnings 'io' ;
 open(F, '|'.($^O eq 'VMS' ? 'mcr ':'')."$^X -e 1|");
 close(F);
@@ -64,7 +66,7 @@ close(G);
 EXPECT
 Can't do bidirectional pipe at - line 3.
 ########
 EXPECT
 Can't do bidirectional pipe at - line 3.
 ########
-# doio.c
+# doio.c [Perl_do_open9]
 use warnings 'io' ;
 open(F, "|      ");
 no warnings 'io' ;
 use warnings 'io' ;
 open(F, "|      ");
 no warnings 'io' ;
@@ -72,7 +74,7 @@ open(G, "|      ");
 EXPECT
 Missing command in piped open at - line 3.
 ########
 EXPECT
 Missing command in piped open at - line 3.
 ########
-# doio.c
+# doio.c [Perl_do_open9]
 use warnings 'io' ;
 open(F, "      |");
 no warnings 'io' ;
 use warnings 'io' ;
 open(F, "      |");
 no warnings 'io' ;
@@ -80,7 +82,7 @@ open(G, "      |");
 EXPECT
 Missing command in piped open at - line 3.
 ########
 EXPECT
 Missing command in piped open at - line 3.
 ########
-# doio.c
+# doio.c [Perl_do_open9]
 use warnings 'io' ;
 open(F, "<true\ncd");
 no warnings 'io' ;
 use warnings 'io' ;
 open(F, "<true\ncd");
 no warnings 'io' ;
@@ -88,7 +90,15 @@ open(G, "<true\ncd");
 EXPECT
 Unsuccessful open on filename containing newline at - line 3.
 ########
 EXPECT
 Unsuccessful open on filename containing newline at - line 3.
 ########
-# doio.c
+# doio.c [Perl_do_close] <<TODO
+use warnings 'unopened' ;
+close "fred" ;
+no warnings 'unopened' ;
+close "joe" ;
+EXPECT
+Close on unopened file <fred> at - line 3.
+########
+# doio.c [Perl_do_tell Perl_do_seek Perl_do_sysseek Perl_my_stat]
 use warnings 'io' ;
 close STDIN ;
 tell(STDIN);
 use warnings 'io' ;
 close STDIN ;
 tell(STDIN);
@@ -107,7 +117,7 @@ seek() on unopened file at - line 5.
 sysseek() on unopened file at - line 6.
 Stat on unopened file <STDIN> at - line 7.
 ########
 sysseek() on unopened file at - line 6.
 Stat on unopened file <STDIN> at - line 7.
 ########
-# doio.c
+# doio.c [Perl_do_print]
 use warnings 'uninitialized' ;
 print $a ;
 no warnings 'uninitialized' ;
 use warnings 'uninitialized' ;
 print $a ;
 no warnings 'uninitialized' ;
@@ -115,13 +125,7 @@ print $b ;
 EXPECT
 Use of uninitialized value at - line 3.
 ########
 EXPECT
 Use of uninitialized value at - line 3.
 ########
-# doio.c
-use warnings 'io' ;
-
-EXPECT
-
-########
-# doio.c
+# doio.c [Perl_my_stat Perl_my_lstat]
 use warnings 'io' ;
 stat "ab\ncd";
 lstat "ab\ncd";
 use warnings 'io' ;
 stat "ab\ncd";
 lstat "ab\ncd";
@@ -132,7 +136,7 @@ EXPECT
 Unsuccessful stat on filename containing newline at - line 3.
 Unsuccessful stat on filename containing newline at - line 4.
 ########
 Unsuccessful stat on filename containing newline at - line 3.
 Unsuccessful stat on filename containing newline at - line 4.
 ########
-# doio.c
+# doio.c [Perl_do_aexec5]
 use warnings 'io' ;
 exec "lskdjfalksdjfdjfkls","" ;
 no warnings 'io' ;
 use warnings 'io' ;
 exec "lskdjfalksdjfdjfkls","" ;
 no warnings 'io' ;
@@ -141,7 +145,7 @@ EXPECT
 OPTION regex
 Can't exec "lskdjfalksdjfdjfkls": .+
 ########
 OPTION regex
 Can't exec "lskdjfalksdjfdjfkls": .+
 ########
-# doio.c
+# doio.c [Perl_do_exec3]
 use warnings 'io' ;
 exec "lskdjfalksdjfdjfkls", "abc" ;
 no warnings 'io' ;
 use warnings 'io' ;
 exec "lskdjfalksdjfdjfkls", "abc" ;
 no warnings 'io' ;
@@ -150,7 +154,7 @@ EXPECT
 OPTION regex
 Can't exec "lskdjfalksdjfdjfkls(:? abc)?": .+
 ########
 OPTION regex
 Can't exec "lskdjfalksdjfdjfkls(:? abc)?": .+
 ########
-# doio.c
+# doio.c [Perl_nextargv]
 $^W = 0 ;
 my $filename = "./temp" ;
 mkdir $filename, 0777 
 $^W = 0 ;
 my $filename = "./temp" ;
 mkdir $filename, 0777 
@@ -177,3 +181,11 @@ EXPECT
 Can't do inplace edit: ./temp is not a regular file at - line 9.
 Can't do inplace edit: ./temp is not a regular file at - line 21.
 
 Can't do inplace edit: ./temp is not a regular file at - line 9.
 Can't do inplace edit: ./temp is not a regular file at - line 21.
 
+########
+# doio.c [Perl_do_eof]
+use warnings 'io' ;
+my $a = eof STDOUT ;
+no warnings 'io' ;
+$a = eof STDOUT ;
+EXPECT
+Filehandle main::STDOUT opened only for output at - line 3.
index 07ec67c..e50420a 100644 (file)
      /---/ should probably be written as "---"
         join(/---/, @foo);
 
      /---/ should probably be written as "---"
         join(/---/, @foo);
 
+    %s() called too early to check prototype           [Perl_peep]
+        fred() ; sub fred ($$) {}
+
+
     Mandatory Warnings 
     ------------------
     Prototype mismatch:                [cv_ckproto]
     Mandatory Warnings 
     ------------------
     Prototype mismatch:                [cv_ckproto]
@@ -794,3 +798,13 @@ use warnings 'syntax' ;
 join /---/, 'x', 'y', 'z';
 EXPECT
 /---/ should probably be written as "---" at - line 3.
 join /---/, 'x', 'y', 'z';
 EXPECT
 /---/ should probably be written as "---" at - line 3.
+########
+# op.c [Perl_peep]
+use warnings 'unsafe' ;
+fred() ; 
+sub fred ($$) {}
+no warnings 'unsafe' ;
+joe() ; 
+sub joe ($$) {}
+EXPECT
+main::fred() called too early to check prototype at - line 3.
index d0d339d..6bd3151 100644 (file)
@@ -1,40 +1,49 @@
-  pp_hot.c     AOK
+  pp_hot.c     
 
 
-  Filehandle %s never opened
+  Filehandle %s never opened                   [pp_print]
     $f = $a = "abc" ; print $f $a
 
     $f = $a = "abc" ; print $f $a
 
-  Filehandle %s opened only for input
+  Filehandle %s opened only for input          [pp_print]
     print STDIN "abc" ;
 
     print STDIN "abc" ;
 
-  Filehandle %s opened only for output
+  Filehandle %s opened only for output         [pp_print]
     print <STDOUT> ;
 
     print <STDOUT> ;
 
-  print on closed filehandle %s
+  print on closed filehandle %s                        [pp_print]
     close STDIN ; print STDIN "abc" ;
 
     close STDIN ; print STDIN "abc" ;
 
-  uninitialized
+  uninitialized                                        [pp_rv2av]
        my $a = undef ; my @b = @$a
 
        my $a = undef ; my @b = @$a
 
-  uninitialized        
+  uninitialized                                        [pp_rv2hv]
        my $a = undef ; my %b = %$a
 
        my $a = undef ; my %b = %$a
 
-  Odd number of elements in hash list
+  Odd number of elements in hash list          [pp_aassign]
        %X = (1,2,3) ;
 
        %X = (1,2,3) ;
 
-  Reference found where even-sized list expected 
+  Reference found where even-sized list expected [pp_aassign]
        $X = [ 1 ..3 ];
 
        $X = [ 1 ..3 ];
 
-  Read on closed filehandle %s
+  Filehandle %s opened only for output         [Perl_do_readline] 
+       open (FH, ">./xcv") ;
+       my $a = <FH> ;
+
+  glob failed (can't start child: %s)          [Perl_do_readline] <<TODO
+
+  Read on closed filehandle %s                 [Perl_do_readline]
     close STDIN ; $a = <STDIN>;
 
     close STDIN ; $a = <STDIN>;
 
-  Deep recursion on subroutine \"%s\"
+  glob failed (child exited with status %d%s)  [Perl_do_readline] <<TODO
+
+  Deep recursion on subroutine \"%s\"          [Perl_sub_crush_depth]
      sub fred { fred() if $a++ < 200} fred()
 
      sub fred { fred() if $a++ < 200} fred()
 
-  Deep recursion on anonymous subroutine 
+  Deep recursion on anonymous subroutine       [Perl_sub_crush_depth]
      $a = sub { &$a if $a++ < 200} &$a
 
      $a = sub { &$a if $a++ < 200} &$a
 
+
 __END__
 __END__
-# pp_hot.c
+# pp_hot.c [pp_print]
 use warnings 'unopened' ;
 $f = $a = "abc" ; 
 print $f $a;
 use warnings 'unopened' ;
 $f = $a = "abc" ; 
 print $f $a;
@@ -43,7 +52,7 @@ print $f $a;
 EXPECT
 Filehandle main::abc never opened at - line 4.
 ########
 EXPECT
 Filehandle main::abc never opened at - line 4.
 ########
-# pp_hot.c
+# pp_hot.c [pp_print]
 use warnings 'io' ;
 print STDIN "anc";
 print <STDOUT>;
 use warnings 'io' ;
 print STDIN "anc";
 print <STDOUT>;
@@ -68,7 +77,7 @@ Filehandle main::FOO opened only for output at - line 6.
 Filehandle main::STDERR opened only for output at - line 7.
 Filehandle main::FOO opened only for output at - line 8.
 ########
 Filehandle main::STDERR opened only for output at - line 7.
 Filehandle main::FOO opened only for output at - line 8.
 ########
-# pp_hot.c
+# pp_hot.c [pp_print]
 use warnings 'closed' ;
 close STDIN ;
 print STDIN "anc";
 use warnings 'closed' ;
 close STDIN ;
 print STDIN "anc";
@@ -77,7 +86,7 @@ print STDIN "anc";
 EXPECT
 print on closed filehandle main::STDIN at - line 4.
 ########
 EXPECT
 print on closed filehandle main::STDIN at - line 4.
 ########
-# pp_hot.c
+# pp_hot.c [pp_rv2av]
 use warnings 'uninitialized' ;
 my $a = undef ;
 my @b = @$a;
 use warnings 'uninitialized' ;
 my $a = undef ;
 my @b = @$a;
@@ -86,7 +95,7 @@ my @c = @$a;
 EXPECT
 Use of uninitialized value at - line 4.
 ########
 EXPECT
 Use of uninitialized value at - line 4.
 ########
-# pp_hot.c
+# pp_hot.c [pp_rv2hv]
 use warnings 'uninitialized' ;
 my $a = undef ;
 my %b = %$a;
 use warnings 'uninitialized' ;
 my $a = undef ;
 my %b = %$a;
@@ -95,7 +104,7 @@ my %c = %$a;
 EXPECT
 Use of uninitialized value at - line 4.
 ########
 EXPECT
 Use of uninitialized value at - line 4.
 ########
-# pp_hot.c
+# pp_hot.c [pp_aassign]
 use warnings 'unsafe' ;
 my %X ; %X = (1,2,3) ;
 no warnings 'unsafe' ;
 use warnings 'unsafe' ;
 my %X ; %X = (1,2,3) ;
 no warnings 'unsafe' ;
@@ -103,7 +112,7 @@ my %Y ; %Y = (1,2,3) ;
 EXPECT
 Odd number of elements in hash assignment at - line 3.
 ########
 EXPECT
 Odd number of elements in hash assignment at - line 3.
 ########
-# pp_hot.c
+# pp_hot.c [pp_aassign]
 use warnings 'unsafe' ;
 my %X ; %X = [1 .. 3] ;
 no warnings 'unsafe' ;
 use warnings 'unsafe' ;
 my %X ; %X = [1 .. 3] ;
 no warnings 'unsafe' ;
@@ -111,7 +120,7 @@ my %Y ; %Y = [1 .. 3] ;
 EXPECT
 Reference found where even-sized list expected at - line 3.
 ########
 EXPECT
 Reference found where even-sized list expected at - line 3.
 ########
-# pp_hot.c
+# pp_hot.c [Perl_do_readline]
 use warnings 'closed' ;
 close STDIN ; $a = <STDIN> ;
 no warnings 'closed' ;
 use warnings 'closed' ;
 close STDIN ; $a = <STDIN> ;
 no warnings 'closed' ;
@@ -119,7 +128,18 @@ $a = <STDIN> ;
 EXPECT
 Read on closed filehandle main::STDIN at - line 3.
 ########
 EXPECT
 Read on closed filehandle main::STDIN at - line 3.
 ########
-# pp_hot.c
+# pp_hot.c [Perl_do_readline]
+use warnings 'io' ;
+my $file = "./xcv" ; unlink $file ;
+open (FH, ">./xcv") ;
+my $a = <FH> ;
+no warnings 'io' ;
+$a = <FH> ;
+unlink $file ;
+EXPECT
+Filehandle main::FH opened only for output at - line 5.
+########
+# pp_hot.c [Perl_sub_crush_depth]
 use warnings 'recursion' ;
 sub fred 
 { 
 use warnings 'recursion' ;
 sub fred 
 { 
@@ -134,7 +154,7 @@ sub fred
 EXPECT
 ok
 ########
 EXPECT
 ok
 ########
-# pp_hot.c
+# pp_hot.c [Perl_sub_crush_depth]
 no warnings 'recursion' ;
 sub fred 
 { 
 no warnings 'recursion' ;
 sub fred 
 { 
@@ -149,7 +169,7 @@ sub fred
 EXPECT
 
 ########
 EXPECT
 
 ########
-# pp_hot.c
+# pp_hot.c [Perl_sub_crush_depth]
 use warnings 'recursion' ;
 $b = sub 
 { 
 use warnings 'recursion' ;
 $b = sub 
 { 
@@ -160,7 +180,7 @@ $b = sub
 EXPECT
 Deep recursion on anonymous subroutine at - line 5.
 ########
 EXPECT
 Deep recursion on anonymous subroutine at - line 5.
 ########
-# pp_hot.c
+# pp_hot.c [Perl_sub_crush_depth]
 no warnings 'recursion' ;
 $b = sub 
 { 
 no warnings 'recursion' ;
 $b = sub 
 { 
index d0caf96..651cdf9 100644 (file)
@@ -1,83 +1,88 @@
   pp_sys.c     AOK
 
   pp_sys.c     AOK
 
-  untie attempted while %d inner references still exist
+  untie attempted while %d inner references still exist        [pp_untie]
     sub TIESCALAR { bless [] } ; tie $a, 'main'; untie $a ;
 
     sub TIESCALAR { bless [] } ; tie $a, 'main'; untie $a ;
 
-  Filehandle %s opened only for input
+  Filehandle %s opened only for input          [pp_leavewrite]
     format STDIN =
     .
     write STDIN;
 
     format STDIN =
     .
     write STDIN;
 
-  Write on closed filehandle %s
+  Write on closed filehandle %s                        [pp_leavewrite]
     format STDIN =
     .
     close STDIN;
     write STDIN ;
 
     format STDIN =
     .
     close STDIN;
     write STDIN ;
 
-  page overflow        
+  page overflow                                        [pp_leavewrite]
 
 
-  Filehandle %s never opened
+  Filehandle %s never opened                   [pp_prtf]
     $a = "abc"; printf $a "fred"
 
     $a = "abc"; printf $a "fred"
 
-  Filehandle %s opened only for input
+  Filehandle %s opened only for input          [pp_prtf]
     $a = "abc"; 
     printf $a "fred"
 
     $a = "abc"; 
     printf $a "fred"
 
-  printf on closed filehandle %s
+  printf on closed filehandle %s               [pp_prtf]
     close STDIN ;
     printf STDIN "fred"
 
     close STDIN ;
     printf STDIN "fred"
 
-  Syswrite on closed filehandle
+  Syswrite on closed filehandle                        [pp_send]
     close STDIN; 
     syswrite STDIN, "fred", 1;
 
     close STDIN; 
     syswrite STDIN, "fred", 1;
 
-  Send on closed socket
+  Send on closed socket                                [pp_send]
     close STDIN; 
     send STDIN, "fred", 1
 
     close STDIN; 
     send STDIN, "fred", 1
 
-  bind() on closed fd
+  bind() on closed fd                          [pp_bind]
     close STDIN; 
     bind STDIN, "fred" ;
 
 
     close STDIN; 
     bind STDIN, "fred" ;
 
 
-  connect() on closed fd
+  connect() on closed fd                       [pp_connect]
     close STDIN; 
     connect STDIN, "fred" ;
 
     close STDIN; 
     connect STDIN, "fred" ;
 
-  listen() on closed fd
+  listen() on closed fd                                [pp_listen]
     close STDIN; 
     listen STDIN, 2;
 
     close STDIN; 
     listen STDIN, 2;
 
-  accept() on closed fd
+  accept() on closed fd                                [pp_accept]
     close STDIN; 
     accept STDIN, "fred" ;
 
     close STDIN; 
     accept STDIN, "fred" ;
 
-  shutdown() on closed fd
+  shutdown() on closed fd                      [pp_shutdown]
     close STDIN; 
     shutdown STDIN, 0;
 
     close STDIN; 
     shutdown STDIN, 0;
 
-  [gs]etsockopt() on closed fd
+  [gs]etsockopt() on closed fd                 [pp_ssockopt]
     close STDIN; 
     setsockopt STDIN, 1,2,3;
     getsockopt STDIN, 1,2;
 
     close STDIN; 
     setsockopt STDIN, 1,2,3;
     getsockopt STDIN, 1,2;
 
-  get{sock, peer}name() on closed fd
+  get{sock, peer}name() on closed fd           [pp_getpeername]
     close STDIN; 
     getsockname STDIN;
     getpeername STDIN;
 
     close STDIN; 
     getsockname STDIN;
     getpeername STDIN;
 
-  warn(warn_nl, "stat");
+  warn(warn_nl, "stat");                       [pp_stat]
 
   Test on unopened file <%s>
        close STDIN ; -T STDIN ;
 
 
   Test on unopened file <%s>
        close STDIN ; -T STDIN ;
 
-  warn(warn_nl, "open");
+  warn(warn_nl, "open");                       [pp_fttext]
     -T "abc\ndef" ;
 
     -T "abc\ndef" ;
 
+  Filehandle %s opened only for output         [pp_sysread]
+       my $file = "./xcv" ;
+       open(F, ">$file") ; 
+       my $a = sysread(F, $a,10) ;
+  
   
 
 __END__
   
 
 __END__
-# pp_sys.c
+# pp_sys.c [pp_untie]
 use warnings 'untie' ;
 sub TIESCALAR { bless [] } ; 
 $b = tie $a, 'main'; 
 use warnings 'untie' ;
 sub TIESCALAR { bless [] } ; 
 $b = tie $a, 'main'; 
@@ -88,7 +93,7 @@ untie $d ;
 EXPECT
 untie attempted while 1 inner references still exist at - line 5.
 ########
 EXPECT
 untie attempted while 1 inner references still exist at - line 5.
 ########
-# pp_sys.c
+# pp_sys.c [pp_leavewrite]
 use warnings 'io' ;
 format STDIN =
 .
 use warnings 'io' ;
 format STDIN =
 .
@@ -98,7 +103,7 @@ write STDIN;
 EXPECT
 Filehandle main::STDIN opened only for input at - line 5.
 ########
 EXPECT
 Filehandle main::STDIN opened only for input at - line 5.
 ########
-# pp_sys.c
+# pp_sys.c [pp_leavewrite]
 use warnings 'closed' ;
 format STDIN =
 .
 use warnings 'closed' ;
 format STDIN =
 .
@@ -109,7 +114,7 @@ write STDIN;
 EXPECT
 Write on closed filehandle main::STDIN at - line 6.
 ########
 EXPECT
 Write on closed filehandle main::STDIN at - line 6.
 ########
-# pp_sys.c
+# pp_sys.c [pp_leavewrite]
 use warnings 'io' ;
 format STDOUT_TOP =
 abc
 use warnings 'io' ;
 format STDOUT_TOP =
 abc
@@ -127,7 +132,7 @@ write ;
 EXPECT
 page overflow at - line 13.
 ########
 EXPECT
 page overflow at - line 13.
 ########
-# pp_sys.c
+# pp_sys.c [pp_prtf]
 use warnings 'unopened' ;
 $a = "abc"; 
 printf $a "fred";
 use warnings 'unopened' ;
 $a = "abc"; 
 printf $a "fred";
@@ -136,7 +141,7 @@ printf $a "fred";
 EXPECT
 Filehandle main::abc never opened at - line 4.
 ########
 EXPECT
 Filehandle main::abc never opened at - line 4.
 ########
-# pp_sys.c
+# pp_sys.c [pp_prtf]
 use warnings 'closed' ;
 close STDIN ;
 printf STDIN "fred";
 use warnings 'closed' ;
 close STDIN ;
 printf STDIN "fred";
@@ -145,7 +150,7 @@ printf STDIN "fred";
 EXPECT
 printf on closed filehandle main::STDIN at - line 4.
 ########
 EXPECT
 printf on closed filehandle main::STDIN at - line 4.
 ########
-# pp_sys.c
+# pp_sys.c [pp_prtf]
 use warnings 'io' ;
 printf STDIN "fred";
 no warnings 'io' ;
 use warnings 'io' ;
 printf STDIN "fred";
 no warnings 'io' ;
@@ -153,7 +158,7 @@ printf STDIN "fred";
 EXPECT
 Filehandle main::STDIN opened only for input at - line 3.
 ########
 EXPECT
 Filehandle main::STDIN opened only for input at - line 3.
 ########
-# pp_sys.c
+# pp_sys.c [pp_send]
 use warnings 'closed' ;
 close STDIN; 
 syswrite STDIN, "fred", 1;
 use warnings 'closed' ;
 close STDIN; 
 syswrite STDIN, "fred", 1;
@@ -162,7 +167,7 @@ syswrite STDIN, "fred", 1;
 EXPECT
 Syswrite on closed filehandle at - line 4.
 ########
 EXPECT
 Syswrite on closed filehandle at - line 4.
 ########
-# pp_sys.c
+# pp_sys.c [pp_prtf pp_send pp_bind pp_connect pp_listen pp_accept pp_shutdown pp_ssockopt ppp_getpeername]
 use warnings 'io' ;
 use Config; 
 BEGIN { 
 use warnings 'io' ;
 use Config; 
 BEGIN { 
@@ -216,7 +221,7 @@ shutdown() on closed fd at - line 27.
 get{sock, peer}name() on closed fd at - line 30.
 get{sock, peer}name() on closed fd at - line 31.
 ########
 get{sock, peer}name() on closed fd at - line 30.
 get{sock, peer}name() on closed fd at - line 31.
 ########
-# pp_sys.c
+# pp_sys.c [pp_stat]
 use warnings 'newline' ;
 stat "abc\ndef";
 no warnings 'newline' ;
 use warnings 'newline' ;
 stat "abc\ndef";
 no warnings 'newline' ;
@@ -224,7 +229,7 @@ stat "abc\ndef";
 EXPECT
 Unsuccessful stat on filename containing newline at - line 3.
 ########
 EXPECT
 Unsuccessful stat on filename containing newline at - line 3.
 ########
-# pp_sys.c
+# pp_sys.c [pp_fttext]
 use warnings 'unopened' ;
 close STDIN ; 
 -T STDIN ;
 use warnings 'unopened' ;
 close STDIN ; 
 -T STDIN ;
@@ -233,10 +238,22 @@ no warnings 'unopened' ;
 EXPECT
 Test on unopened file <STDIN> at - line 4.
 ########
 EXPECT
 Test on unopened file <STDIN> at - line 4.
 ########
-# pp_sys.c
+# pp_sys.c [pp_fttext]
 use warnings 'newline' ;
 -T "abc\ndef" ;
 no warnings 'newline' ;
 -T "abc\ndef" ;
 EXPECT
 Unsuccessful open on filename containing newline at - line 3.
 use warnings 'newline' ;
 -T "abc\ndef" ;
 no warnings 'newline' ;
 -T "abc\ndef" ;
 EXPECT
 Unsuccessful open on filename containing newline at - line 3.
+########
+# pp_sys.c [pp_sysread]
+use warnings 'io' ;
+my $file = "./xcv" ;
+open(F, ">$file") ; 
+my $a = sysread(F, $a,10) ;
+no warnings 'io' ;
+my $a = sysread(F, $a,10) ;
+close F ;
+unlink $file ;
+EXPECT
+Filehandle main::F opened only for output at - line 5.
index 6aa9fa6..9c3677e 100644 (file)
@@ -1,18 +1,25 @@
   regcomp.c    AOK
 
   regcomp.c    AOK
 
-  %.*s matches null string many times   
+  Strange *+?{} on zero-length expression      [S_study_chunk]
+       /(?=a)?/
 
 
+  %.*s matches null string many times          [S_regpiece]
        $a = "ABC123" ; $a =~ /(?=a)*/'
 
        $a = "ABC123" ; $a =~ /(?=a)*/'
 
-  Strange *+?{} on zero-length expression
+  /%.127s/: Unrecognized escape \\%c passed through"   [S_regatom] 
+       /\m/
 
 
-       /(?=a)?/
+  Character class syntax [. .] is reserved for future extensions [S_regpposixcc]
+
+  Character class syntax [= =] is reserved for future extensions [S_checkposixcc]
+
+  Character class syntax [%c %c] belongs inside character classes [S_checkposixcc] 
+  
 
 
-  Character class syntax [. .] is reserved for future extensions
-  Character class syntax [= =] is reserved for future extensions
+  
 
 __END__
 
 __END__
-# regcomp.c
+# regcomp.c [S_regpiece]
 use warnings 'unsafe' ;
 my $a = "ABC123" ; 
 $a =~ /(?=a)*/ ;
 use warnings 'unsafe' ;
 my $a = "ABC123" ; 
 $a =~ /(?=a)*/ ;
@@ -21,7 +28,7 @@ $a =~ /(?=a)*/ ;
 EXPECT
 (?=a)* matches null string many times at - line 4.
 ########
 EXPECT
 (?=a)* matches null string many times at - line 4.
 ########
-# regcomp.c
+# regcomp.c [S_study_chunk]
 use warnings 'unsafe' ;
 $_ = "" ;
 /(?=a)?/;
 use warnings 'unsafe' ;
 $_ = "" ;
 /(?=a)?/;
@@ -30,7 +37,14 @@ no warnings 'unsafe' ;
 EXPECT
 Strange *+?{} on zero-length expression at - line 4.
 ########
 EXPECT
 Strange *+?{} on zero-length expression at - line 4.
 ########
-# regcomp.c
+# regcomp.c [S_regatom]
+use warnings 'unsafe' ;
+$a =~ /\m/ ;
+no warnings 'unsafe' ;
+EXPECT
+Unrecognized escape \m passed through at - line 3.
+########
+# regcomp.c [S_regpposixcc S_checkposixcc]
 use warnings 'unsafe' ;
 $_ = "" ;
 /[:alpha:]/;
 use warnings 'unsafe' ;
 $_ = "" ;
 /[:alpha:]/;
index a90e9d3..bac2c42 100644 (file)
@@ -32,6 +32,8 @@
 
   Undefined value assigned to typeglob
 
 
   Undefined value assigned to typeglob
 
+  Reference is already weak                    [Perl_sv_rvweaken] <<TODO
+
   Mandatory Warnings
   ------------------
   Malformed UTF-8 character [sv_pos_b2u]
   Mandatory Warnings
   ------------------
   Malformed UTF-8 character [sv_pos_b2u]
index 661d3d4..182cc17 100644 (file)
@@ -96,6 +96,31 @@ toke.c       AOK
     \x%.*s will produce malformed UTF-8 character; use \x{%.*s} for that
         use utf8 ; 
        $_ = "\xffe"
     \x%.*s will produce malformed UTF-8 character; use \x{%.*s} for that
         use utf8 ; 
        $_ = "\xffe"
+
+    Unrecognized escape \\%c passed through
+        $a = "\m" ;
+
+    %s number > %s non-portable
+        my $a =  0b011111111111111111111111111111110 ;
+        $a =  0b011111111111111111111111111111111 ;
+        $a =  0b111111111111111111111111111111111 ;
+        $a =  0x0fffffffe ;
+        $a =  0x0ffffffff ;
+        $a =  0x1ffffffff ;
+        $a =  0037777777776 ;
+        $a =  0037777777777 ;
+        $a =  0047777777777 ;
+
+    Integer overflow in binary number
+        my $a =  0b011111111111111111111111111111110 ;
+        $a =  0b011111111111111111111111111111111 ;
+        $a =  0b111111111111111111111111111111111 ;
+        $a =  0x0fffffffe ;
+        $a =  0x0ffffffff ;
+        $a =  0x1ffffffff ;
+        $a =  0037777777776 ;
+        $a =  0037777777777 ;
+        $a =  0047777777777 ;
      
     Mandatory Warnings
     ------------------
      
     Mandatory Warnings
     ------------------
@@ -524,3 +549,63 @@ Operator or semicolon missing before *foo at - line 8.
 Ambiguous use of * resolved as operator * at - line 8.
 Operator or semicolon missing before *foo at - line 10.
 Ambiguous use of * resolved as operator * at - line 10.
 Ambiguous use of * resolved as operator * at - line 8.
 Operator or semicolon missing before *foo at - line 10.
 Ambiguous use of * resolved as operator * at - line 10.
+########
+# toke.c
+use warnings 'unsafe' ;
+my $a = "\m" ;
+no warnings 'unsafe' ;
+$a = "\m" ;
+EXPECT
+Unrecognized escape \m passed through at - line 3.
+########
+# toke.c
+use warnings 'portable' ;
+my $a =  0b011111111111111111111111111111110 ;
+   $a =  0b011111111111111111111111111111111 ;
+   $a =  0b111111111111111111111111111111111 ;
+   $a =  0x0fffffffe ;
+   $a =  0x0ffffffff ;
+   $a =  0x1ffffffff ;
+   $a =  0037777777776 ;
+   $a =  0037777777777 ;
+   $a =  0047777777777 ;
+no warnings 'portable' ;
+   $a =  0b011111111111111111111111111111110 ;
+   $a =  0b011111111111111111111111111111111 ;
+   $a =  0b111111111111111111111111111111111 ;
+   $a =  0x0fffffffe ;
+   $a =  0x0ffffffff ;
+   $a =  0x1ffffffff ;
+   $a =  0037777777776 ;
+   $a =  0037777777777 ;
+   $a =  0047777777777 ;
+EXPECT
+Binary number > 0b11111111111111111111111111111111 non-portable at - line 5.
+Hexadecimal number > 0xffffffff non-portable at - line 8.
+Octal number > 037777777777 non-portable at - line 11.
+########
+# toke.c
+use warnings 'overflow' ;
+my $a =  0b011111111111111111111111111111110 ;
+   $a =  0b011111111111111111111111111111111 ;
+   $a =  0b111111111111111111111111111111111 ;
+   $a =  0x0fffffffe ;
+   $a =  0x0ffffffff ;
+   $a =  0x1ffffffff ;
+   $a =  0037777777776 ;
+   $a =  0037777777777 ;
+   $a =  0047777777777 ;
+no warnings 'overflow' ;
+   $a =  0b011111111111111111111111111111110 ;
+   $a =  0b011111111111111111111111111111111 ;
+   $a =  0b111111111111111111111111111111111 ;
+   $a =  0x0fffffffe ;
+   $a =  0x0ffffffff ;
+   $a =  0x1ffffffff ;
+   $a =  0037777777776 ;
+   $a =  0037777777777 ;
+   $a =  0047777777777 ;
+EXPECT
+Integer overflow in binary number at - line 5.
+Integer overflow in hexadecimal number at - line 8.
+Integer overflow in octal number at - line 11.
index f4f8637..6dbb1be 100644 (file)
@@ -1,11 +1,16 @@
-  universal.c TODO
+  universal.c AOK
 
 
-  Can't locate package %s for @%s::ISA
+  Can't locate package %s for @%s::ISA [S_isa_lookup]
+      
 
 
 __END__
 
 
 __END__
-# universal.c
+# universal.c [S_isa_lookup]
 use warnings 'misc' ;
 use warnings 'misc' ;
-
+@ISA = qw(Joe) ;
+my $a = bless [] ;
+UNIVERSAL::isa $a, Jim ;
 EXPECT
 EXPECT
-
+Can't locate package Joe for @main::ISA at - line 5.
+Can't locate package Joe for @main::ISA.
+Can't locate package Joe for @main::ISA.
index 30f552a..b11514d 100644 (file)
      <<<<<< Add a test when somethig actually calls utf16_to_utf8
 
 __END__
      <<<<<< Add a test when somethig actually calls utf16_to_utf8
 
 __END__
-# utf8.c
+# utf8.c [utf8_to_uv]
 use utf8 ;
 my $a = ord "\x80" ;
 EXPECT
 Malformed UTF-8 character at - line 3.
 ########
 use utf8 ;
 my $a = ord "\x80" ;
 EXPECT
 Malformed UTF-8 character at - line 3.
 ########
-# utf8.c
+# utf8.c [utf8_to_uv]
 use utf8 ;
 my $a = ord "\x80" ;
 {
 use utf8 ;
 my $a = ord "\x80" ;
 {
@@ -35,13 +35,13 @@ Malformed UTF-8 character at - line 3.
 \x80 will produce malformed UTF-8 character; use \x{80} for that at - line 6.
 Malformed UTF-8 character at - line 6.
 ########
 \x80 will produce malformed UTF-8 character; use \x{80} for that at - line 6.
 Malformed UTF-8 character at - line 6.
 ########
-# utf8.c
+# utf8.c [utf8_to_uv]
 use utf8 ;
 my $a = ord "\xf080" ;
 EXPECT
 Malformed UTF-8 character at - line 3.
 ########
 use utf8 ;
 my $a = ord "\xf080" ;
 EXPECT
 Malformed UTF-8 character at - line 3.
 ########
-# utf8.c
+# utf8.c [utf8_to_uv]
 use utf8 ;
 my $a = ord "\xf080" ;
 {
 use utf8 ;
 my $a = ord "\xf080" ;
 {
index e9093c4..6d82d13 100644 (file)
 
      Illegal binary digit ignored
       my $a = oct "0b9" ;
 
      Illegal binary digit ignored
       my $a = oct "0b9" ;
+     
+     Integer overflow in binary number
+       my $a =  oct "0b111111111111111111111111111111111111111111" ;
+     Binary number > 0b11111111111111111111111111111111 non-portable
+       $a =  oct "0b111111111111111111111111111111111" ;
+     Integer overflow in octal number
+       my $a =  oct "0777777777777777777777777777777777777777777777777" ;
+     Octal number > 037777777777 non-portable
+       $a =  oct "0047777777777" ;
+     Integer overflow in hexadecimal number
+       my $a =  hex "0xffffffffffffffffffff" ;
+     Hexadecimal number > 0xffffffff non-portable
+       $a =  hex "0x1ffffffff" ;
 
 __END__
 # util.c
 use warnings 'digit' ;
 my $a = oct "029" ;
 no warnings 'digit' ;
 
 __END__
 # util.c
 use warnings 'digit' ;
 my $a = oct "029" ;
 no warnings 'digit' ;
-my $a = oct "029" ;
+$a = oct "029" ;
 EXPECT
 Illegal octal digit '9' ignored at - line 3.
 ########
 # util.c
 use warnings 'digit' ;
 EXPECT
 Illegal octal digit '9' ignored at - line 3.
 ########
 # util.c
 use warnings 'digit' ;
-*a =  hex "0xv9" ;
+my $a =  hex "0xv9" ;
 no warnings 'digit' ;
 no warnings 'digit' ;
-*a =  hex "0xv9" ;
+$a =  hex "0xv9" ;
 EXPECT
 Illegal hexadecimal digit 'v' ignored at - line 3.
 ########
 # util.c
 use warnings 'digit' ;
 EXPECT
 Illegal hexadecimal digit 'v' ignored at - line 3.
 ########
 # util.c
 use warnings 'digit' ;
-*a =  oct "0b9" ;
+my $a =  oct "0b9" ;
 no warnings 'digit' ;
 no warnings 'digit' ;
-*a =  oct "0b9" ;
+$a =  oct "0b9" ;
 EXPECT
 Illegal binary digit '9' ignored at - line 3.
 EXPECT
 Illegal binary digit '9' ignored at - line 3.
+########
+# util.c
+use warnings 'overflow' ;
+my $a =  oct "0b111111111111111111111111111111111111111111" ;
+no warnings 'overflow' ;
+$a =  oct "0b111111111111111111111111111111111111111111" ;
+EXPECT
+Integer overflow in binary number at - line 3.
+########
+# util.c
+use warnings 'overflow' ;
+my $a =  hex "0xffffffffffffffffffff" ;
+no warnings 'overflow' ;
+$a =  hex "0xffffffffffffffffffff" ;
+EXPECT
+Integer overflow in hexadecimal number at - line 3.
+########
+# util.c
+use warnings 'overflow' ;
+my $a =  oct "0777777777777777777777777777777777777777777777777" ;
+no warnings 'overflow' ;
+$a =  oct "0777777777777777777777777777777777777777777777777" ;
+EXPECT
+Integer overflow in octal number at - line 3.
+########
+# util.c
+use warnings 'portable' ;
+my $a =  oct "0b011111111111111111111111111111110" ;
+   $a =  oct "0b011111111111111111111111111111111" ;
+   $a =  oct "0b111111111111111111111111111111111" ;
+no warnings 'portable' ;
+   $a =  oct "0b011111111111111111111111111111110" ;
+   $a =  oct "0b011111111111111111111111111111111" ;
+   $a =  oct "0b111111111111111111111111111111111" ;
+EXPECT
+Binary number > 0b11111111111111111111111111111111 non-portable at - line 5.
+########
+# util.c
+use warnings 'portable' ;
+my $a =  hex "0x0fffffffe" ;
+   $a =  hex "0x0ffffffff" ;
+   $a =  hex "0x1ffffffff" ;
+no warnings 'portable' ;
+   $a =  hex "0x0fffffffe" ;
+   $a =  hex "0x0ffffffff" ;
+   $a =  hex "0x1ffffffff" ;
+EXPECT
+Hexadecimal number > 0xffffffff non-portable at - line 5.
+########
+# util.c
+use warnings 'portable' ;
+my $a =  oct "0037777777776" ;
+   $a =  oct "0037777777777" ;
+   $a =  oct "0047777777777" ;
+no warnings 'portable' ;
+   $a =  oct "0037777777776" ;
+   $a =  oct "0037777777777" ;
+   $a =  oct "0047777777777" ;
+EXPECT
+Octal number > 037777777777 non-portable at - line 5.
diff --git a/toke.c b/toke.c
index 2561451..354b1d4 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -6582,9 +6582,8 @@ Perl_scan_num(pTHX_ char *start)
                            dTHR;
                            overflowed = TRUE;
                            n = (NV) u;
                            dTHR;
                            overflowed = TRUE;
                            n = (NV) u;
-                           if (ckWARN_d(WARN_UNSAFE))
-                               Perl_warner(aTHX_ ((shift == 3) ?
-                                                  WARN_OCTAL : WARN_UNSAFE),
+                           if (ckWARN_d(WARN_OVERFLOW))
+                               Perl_warner(aTHX_ WARN_OVERFLOW,
                                            "Integer overflow in %s number",
                                            base);
                        } else
                                            "Integer overflow in %s number",
                                            base);
                        } else
@@ -6613,8 +6612,8 @@ Perl_scan_num(pTHX_ char *start)
            sv = NEWSV(92,0);
            if (overflowed) {
                dTHR;
            sv = NEWSV(92,0);
            if (overflowed) {
                dTHR;
-               if (ckWARN(WARN_UNSAFE) && n > 4294967295.0)
-                   Perl_warner(aTHX_ WARN_UNSAFE,
+               if (ckWARN(WARN_PORTABLE) && n > 4294967295.0)
+                   Perl_warner(aTHX_ WARN_PORTABLE,
                                "%s number > %s non-portable",
                                Base, max);
                sv_setnv(sv, n);
                                "%s number > %s non-portable",
                                Base, max);
                sv_setnv(sv, n);
@@ -6622,8 +6621,8 @@ Perl_scan_num(pTHX_ char *start)
            else {
 #if UV_SIZEOF > 4
                dTHR;
            else {
 #if UV_SIZEOF > 4
                dTHR;
-               if (ckWARN(WARN_UNSAFE) && u > 0xffffffff)
-                   Perl_warner(aTHX_ WARN_UNSAFE,
+               if (ckWARN(WARN_PORTABLE) && u > 0xffffffff)
+                   Perl_warner(aTHX_ WARN_PORTABLE,
                                "%s number > %s non-portable",
                                Base, max);
 #endif
                                "%s number > %s non-portable",
                                Base, max);
 #endif