additional tests for change#5934 (from Paul Marquess, who also

sent in the same fix)

p4raw-link: @5934 on //depot/perl: f0a6fc868045c83877fa78e3e0f6f0be236d2a27

p4raw-id: //depot/perl@5936

diff --git a/t/pragma/warn/2use b/t/pragma/warn/2use
index 60a60c3..b489d62 100644 (file)
--- a/t/pragma/warn/2use
+++ b/t/pragma/warn/2use
@@ -120,175 +120,223 @@ Use of uninitialized value in scalar chop at - line 3.
 ########
 
 # Check scope of pragma with eval
-no warnings ;
-eval {
+use warnings;
+{
+    no warnings ;
+    eval {
+        my $b ; chop $b ;
+    }; print STDERR $@ ;
     my $b ; chop $b ;
-}; print STDERR $@ ;
-my $b ; chop $b ;
+}
 EXPECT
 
 ########
 
 # Check scope of pragma with eval
-no warnings ;
-eval {
-    use warnings 'uninitialized' ;
+use warnings;
+{
+    no warnings ;
+    eval {
+        use warnings 'uninitialized' ;
+        my $b ; chop $b ;
+    }; print STDERR $@ ;
     my $b ; chop $b ;
-}; print STDERR $@ ;
-my $b ; chop $b ;
+}
 EXPECT
-Use of uninitialized value in scalar chop at - line 6.
+Use of uninitialized value in scalar chop at - line 8.
 ########
 
 # Check scope of pragma with eval
-use warnings 'uninitialized' ;
-eval {
+no warnings;
+{
+    use warnings 'uninitialized' ;
+    eval {
+        my $b ; chop $b ;
+    }; print STDERR $@ ;
     my $b ; chop $b ;
-}; print STDERR $@ ;
-my $b ; chop $b ;
+}
 EXPECT
-Use of uninitialized value in scalar chop at - line 5.
 Use of uninitialized value in scalar chop at - line 7.
+Use of uninitialized value in scalar chop at - line 9.
 ########
 
 # Check scope of pragma with eval
-use warnings 'uninitialized' ;
-eval {
-    no warnings ;
+no warnings;
+{
+    use warnings 'uninitialized' ;
+    eval {
+        no warnings ;
+        my $b ; chop $b ;
+    }; print STDERR $@ ;
     my $b ; chop $b ;
-}; print STDERR $@ ;
-my $b ; chop $b ;
+}
 EXPECT
-Use of uninitialized value in scalar chop at - line 8.
+Use of uninitialized value in scalar chop at - line 10.
 ########
 
 # Check scope of pragma with eval
-no warnings ;
-eval {
+use warnings;
+{
+    no warnings ;
+    eval {
+        1 if $a EQ $b ;
+    }; print STDERR $@ ;
     1 if $a EQ $b ;
-}; print STDERR $@ ;
-1 if $a EQ $b ;
+}
 EXPECT
 
 ########
 
 # Check scope of pragma with eval
-no warnings ;
-eval {
-    use warnings 'deprecated' ;
+use warnings;
+{
+    no warnings ;
+    eval {
+        use warnings 'deprecated' ;
+        1 if $a EQ $b ;
+    }; print STDERR $@ ;
     1 if $a EQ $b ;
-}; print STDERR $@ ;
-1 if $a EQ $b ;
+}
 EXPECT
-Use of EQ is deprecated at - line 6.
+Use of EQ is deprecated at - line 8.
 ########
 
 # Check scope of pragma with eval
-use warnings 'deprecated' ;
-eval {
+no warnings;
+{
+    use warnings 'deprecated' ;
+    eval {
+        1 if $a EQ $b ;
+    }; print STDERR $@ ;
     1 if $a EQ $b ;
-}; print STDERR $@ ;
-1 if $a EQ $b ;
+}
 EXPECT
-Use of EQ is deprecated at - line 5.
 Use of EQ is deprecated at - line 7.
+Use of EQ is deprecated at - line 9.
 ########
 
 # Check scope of pragma with eval
-use warnings 'deprecated' ;
-eval {
-    no warnings ;
+no warnings;
+{
+    use warnings 'deprecated' ;
+    eval {
+        no warnings ;
+        1 if $a EQ $b ;
+    }; print STDERR $@ ;
     1 if $a EQ $b ;
-}; print STDERR $@ ;
-1 if $a EQ $b ;
+}
 EXPECT
-Use of EQ is deprecated at - line 8.
+Use of EQ is deprecated at - line 10.
 ########
 
 # Check scope of pragma with eval
-no warnings ;
-eval '
+use warnings;
+{
+    no warnings ;
+    eval '
+        my $b ; chop $b ;
+    '; print STDERR $@ ;
     my $b ; chop $b ;
-'; print STDERR $@ ;
-my $b ; chop $b ;
+}
 EXPECT
 
 ########
 
 # Check scope of pragma with eval
-no warnings ;
-eval q[ 
-    use warnings 'uninitialized' ;
+use warnings;
+{
+    no warnings ;
+    eval q[ 
+        use warnings 'uninitialized' ;
+        my $b ; chop $b ;
+    ]; print STDERR $@;
     my $b ; chop $b ;
-]; print STDERR $@;
-my $b ; chop $b ;
+}
 EXPECT
 Use of uninitialized value in scalar chop at (eval 1) line 3.
 ########
 
 # Check scope of pragma with eval
-use warnings 'uninitialized' ;
-eval '
+no warnings;
+{
+    use warnings 'uninitialized' ;
+    eval '
+        my $b ; chop $b ;
+    '; print STDERR $@ ;
     my $b ; chop $b ;
-'; print STDERR $@ ;
-my $b ; chop $b ;
+}
 EXPECT
 Use of uninitialized value in scalar chop at (eval 1) line 2.
-Use of uninitialized value in scalar chop at - line 7.
+Use of uninitialized value in scalar chop at - line 9.
 ########
 
 # Check scope of pragma with eval
-use warnings 'uninitialized' ;
-eval '
-    no warnings ;
+no warnings;
+{
+    use warnings 'uninitialized' ;
+    eval '
+        no warnings ;
+        my $b ; chop $b ;
+    '; print STDERR $@ ;
     my $b ; chop $b ;
-'; print STDERR $@ ;
-my $b ; chop $b ;
+}
 EXPECT
-Use of uninitialized value in scalar chop at - line 8.
+Use of uninitialized value in scalar chop at - line 10.
 ########
 
 # Check scope of pragma with eval
-no warnings ;
-eval '
+use warnings;
+{
+    no warnings ;
+    eval '
+        1 if $a EQ $b ;
+    '; print STDERR $@ ;
     1 if $a EQ $b ;
-'; print STDERR $@ ;
-1 if $a EQ $b ;
+}
 EXPECT
 
 ########
 
 # Check scope of pragma with eval
-no warnings ;
-eval q[ 
-    use warnings 'deprecated' ;
+use warnings;
+{
+    no warnings ;
+    eval q[ 
+        use warnings 'deprecated' ;
+        1 if $a EQ $b ;
+    ]; print STDERR $@;
     1 if $a EQ $b ;
-]; print STDERR $@;
-1 if $a EQ $b ;
+}
 EXPECT
 Use of EQ is deprecated at (eval 1) line 3.
 ########
 
 # Check scope of pragma with eval
-use warnings 'deprecated' ;
-eval '
+no warnings;
+{
+    use warnings 'deprecated' ;
+    eval '
+        1 if $a EQ $b ;
+    '; print STDERR $@;
     1 if $a EQ $b ;
-'; print STDERR $@;
-1 if $a EQ $b ;
+}
 EXPECT
-Use of EQ is deprecated at - line 7.
+Use of EQ is deprecated at - line 9.
 Use of EQ is deprecated at (eval 1) line 2.
 ########
 
 # Check scope of pragma with eval
-use warnings 'deprecated' ;
-eval '
-    no warnings ;
+no warnings;
+{
+    use warnings 'deprecated' ;
+    eval '
+        no warnings ;
+        1 if $a EQ $b ;
+    '; print STDERR $@;
     1 if $a EQ $b ;
-'; print STDERR $@;
-1 if $a EQ $b ;
+}
 EXPECT
-Use of EQ is deprecated at - line 8.
+Use of EQ is deprecated at - line 10.
 ########
 
 # Check the additive nature of the pragma

diff --git a/t/pragma/warn/3both b/t/pragma/warn/3both
index 132b99b..335e1b2 100644 (file)
--- a/t/pragma/warn/3both
+++ b/t/pragma/warn/3both
@@ -195,3 +195,72 @@ my $b ;
 chop $b ;
 EXPECT
 Use of uninitialized value in scalar chop at - line 7.
+########
+
+# Check scope of pragma with eval
+BEGIN {  $^W = 1 }
+{
+    no warnings ;
+    eval '
+        my $b ; chop $b ;
+    '; print STDERR $@ ;
+    my $b ; chop $b ;
+}
+EXPECT
+
+########
+
+# Check scope of pragma with eval
+BEGIN {  $^W = 1 }
+use warnings;
+{
+    no warnings ;
+    eval q[ 
+        use warnings 'uninitialized' ;
+        my $b ; chop $b ;
+    ]; print STDERR $@;
+    my $b ; chop $b ;
+}
+EXPECT
+Use of uninitialized value in scalar chop at (eval 1) line 3.
+########
+
+# Check scope of pragma with eval
+BEGIN {  $^W = 0 }
+{
+    use warnings 'uninitialized' ;
+    eval '
+        my $b ; chop $b ;
+    '; print STDERR $@ ;
+    my $b ; chop $b ;
+}
+EXPECT
+Use of uninitialized value in scalar chop at (eval 1) line 2.
+Use of uninitialized value in scalar chop at - line 9.
+########
+
+# Check scope of pragma with eval
+BEGIN {  $^W = 0 }
+{
+    use warnings 'uninitialized' ;
+    eval '
+        no warnings ;
+        my $b ; chop $b ;
+    '; print STDERR $@ ;
+    my $b ; chop $b ;
+}
+EXPECT
+Use of uninitialized value in scalar chop at - line 10.
+########
+
+# Check scope of pragma with eval
+BEGIN {  $^W = 1 }
+{
+    no warnings ;
+    eval '
+        1 if $a EQ $b ;
+    '; print STDERR $@ ;
+    1 if $a EQ $b ;
+}
+EXPECT
+

diff --git a/t/pragma/warn/4lint b/t/pragma/warn/4lint
index db54f31..56e3fab 100644 (file)
--- a/t/pragma/warn/4lint
+++ b/t/pragma/warn/4lint
@@ -110,3 +110,107 @@ my $a ; chop $a ;
 EXPECT
 Use of EQ is deprecated at ./abc line 3.
 Use of uninitialized value in scalar chop at - line 3.
+########
+-W
+# Check scope of pragma with eval
+{
+    no warnings ;
+    eval '
+        my $b ; chop $b ;
+    '; print STDERR $@ ;
+    my $b ; chop $b ;
+}
+EXPECT
+Use of uninitialized value in scalar chop at (eval 1) line 2.
+Use of uninitialized value in scalar chop at - line 8.
+########
+-W
+# Check scope of pragma with eval
+use warnings;
+{
+    no warnings ;
+    eval q[ 
+        use warnings 'uninitialized' ;
+        my $b ; chop $b ;
+    ]; print STDERR $@;
+    my $b ; chop $b ;
+}
+EXPECT
+Use of uninitialized value in scalar chop at (eval 1) line 3.
+Use of uninitialized value in scalar chop at - line 10.
+########
+-W
+# Check scope of pragma with eval
+no warnings;
+{
+    use warnings 'uninitialized' ;
+    eval '
+        my $b ; chop $b ;
+    '; print STDERR $@ ;
+    my $b ; chop $b ;
+}
+EXPECT
+Use of uninitialized value in scalar chop at (eval 1) line 2.
+Use of uninitialized value in scalar chop at - line 9.
+########
+-W
+# Check scope of pragma with eval
+no warnings;
+{
+    use warnings 'uninitialized' ;
+    eval '
+        no warnings ;
+        my $b ; chop $b ;
+    '; print STDERR $@ ;
+    my $b ; chop $b ;
+}
+EXPECT
+Use of uninitialized value in scalar chop at (eval 1) line 3.
+Use of uninitialized value in scalar chop at - line 10.
+########
+-W
+# Check scope of pragma with eval
+use warnings;
+{
+    my $a = "1"; my $b = "2";
+    no warnings ;
+    eval q[ 
+        use warnings 'deprecated' ;
+        1 if $a EQ $b ;
+    ]; print STDERR $@;
+    1 if $a EQ $b ;
+}
+EXPECT
+Use of EQ is deprecated at - line 11.
+Use of EQ is deprecated at (eval 1) line 3.
+########
+-W
+# Check scope of pragma with eval
+no warnings;
+{
+    my $a = "1"; my $b = "2";
+    use warnings 'deprecated' ;
+    eval '
+        1 if $a EQ $b ;
+    '; print STDERR $@;
+    1 if $a EQ $b ;
+}
+EXPECT
+Use of EQ is deprecated at - line 10.
+Use of EQ is deprecated at (eval 1) line 2.
+########
+-W
+# Check scope of pragma with eval
+no warnings;
+{
+    my $a = "1"; my $b = "2";
+    use warnings 'deprecated' ;
+    eval '
+        no warnings ;
+        1 if $a EQ $b ;
+    '; print STDERR $@;
+    1 if $a EQ $b ;
+}
+EXPECT
+Use of EQ is deprecated at - line 11.
+Use of EQ is deprecated at (eval 1) line 3.

diff --git a/t/pragma/warn/5nolint b/t/pragma/warn/5nolint
index 994190a..2459968 100644 (file)
--- a/t/pragma/warn/5nolint
+++ b/t/pragma/warn/5nolint
@@ -94,3 +94,111 @@ $^W = 1 ;
 require "./abc";
 my $a ; chop $a ;
 EXPECT
+########
+-X
+# Check scope of pragma with eval
+use warnings;
+{
+    no warnings ;
+    eval '
+        my $b ; chop $b ;
+    '; print STDERR $@ ;
+    my $b ; chop $b ;
+}
+EXPECT
+
+########
+-X
+# Check scope of pragma with eval
+use warnings;
+{
+    no warnings ;
+    eval q[ 
+        use warnings 'uninitialized' ;
+        my $b ; chop $b ;
+    ]; print STDERR $@;
+    my $b ; chop $b ;
+}
+EXPECT
+
+########
+-X
+# Check scope of pragma with eval
+no warnings;
+{
+    use warnings 'uninitialized' ;
+    eval '
+        my $b ; chop $b ;
+    '; print STDERR $@ ;
+    my $b ; chop $b ;
+}
+EXPECT
+
+########
+-X
+# Check scope of pragma with eval
+no warnings;
+{
+    use warnings 'uninitialized' ;
+    eval '
+        no warnings ;
+        my $b ; chop $b ;
+    '; print STDERR $@ ;
+    my $b ; chop $b ;
+}
+EXPECT
+
+########
+-X
+# Check scope of pragma with eval
+use warnings;
+{
+    no warnings ;
+    eval '
+        1 if $a EQ $b ;
+    '; print STDERR $@ ;
+    1 if $a EQ $b ;
+}
+EXPECT
+
+########
+-X
+# Check scope of pragma with eval
+use warnings;
+{
+    no warnings ;
+    eval q[ 
+        use warnings 'deprecated' ;
+        1 if $a EQ $b ;
+    ]; print STDERR $@;
+    1 if $a EQ $b ;
+}
+EXPECT
+
+########
+-X
+# Check scope of pragma with eval
+no warnings;
+{
+    use warnings 'deprecated' ;
+    eval '
+        1 if $a EQ $b ;
+    '; print STDERR $@;
+    1 if $a EQ $b ;
+}
+EXPECT
+
+########
+-X
+# Check scope of pragma with eval
+no warnings;
+{
+    use warnings 'deprecated' ;
+    eval '
+        no warnings ;
+        1 if $a EQ $b ;
+    '; print STDERR $@;
+    1 if $a EQ $b ;
+}
+EXPECT
+

diff --git a/t/pragma/warn/6default b/t/pragma/warn/6default
index dd3d182..a8aafee 100644 (file)
--- a/t/pragma/warn/6default
+++ b/t/pragma/warn/6default
@@ -51,3 +51,71 @@ EXPECT
 Integer overflow in binary number at - line 3.
 Illegal binary digit '2' ignored at - line 3.
 Binary number > 0b11111111111111111111111111111111 non-portable at - line 3.
+########
+
+# Check scope of pragma with eval
+use warnings;
+{
+    no warnings ;
+    eval '
+       my $a = oct "0xfffffffffffffffffg" ;
+    '; print STDERR $@ ;
+    my $a = oct "0xfffffffffffffffffg" ;
+}
+EXPECT
+
+########
+
+# Check scope of pragma with eval
+use warnings;
+{
+    no warnings ;
+    eval q[ 
+        use warnings ;
+       my $a = oct "0xfffffffffffffffffg" ;
+    ]; print STDERR $@;
+    my $a = oct "0xfffffffffffffffffg" ;
+}
+EXPECT
+Integer overflow in hexadecimal number at (eval 1) line 3.
+Illegal hexadecimal digit 'g' ignored at (eval 1) line 3.
+Hexadecimal number > 0xffffffff non-portable at (eval 1) line 3.
+########
+
+# Check scope of pragma with eval
+no warnings;
+{
+    use warnings ;
+    eval '
+       my $a = oct "0xfffffffffffffffffg" ;
+    '; print STDERR $@ ;
+}
+EXPECT
+Integer overflow in hexadecimal number at (eval 1) line 2.
+Illegal hexadecimal digit 'g' ignored at (eval 1) line 2.
+Hexadecimal number > 0xffffffff non-portable at (eval 1) line 2.
+########
+
+# Check scope of pragma with eval
+no warnings;
+{
+    use warnings;
+    eval '
+        no warnings ;
+       my $a = oct "0xfffffffffffffffffg" ;
+    '; print STDERR $@ ;
+}
+EXPECT
+
+########
+
+# Check scope of pragma with eval
+no warnings;
+{
+    use warnings 'deprecated' ;
+    eval '
+       my $a = oct "0xfffffffffffffffffg" ;
+    '; print STDERR $@;
+}
+EXPECT
+