summaryrefslogtreecommitdiff
path: root/t/pragma/warn
diff options
context:
space:
mode:
authorGurusamy Sarathy <gsar@cpan.org>1998-09-23 06:24:49 +0000
committerGurusamy Sarathy <gsar@cpan.org>1998-09-23 06:24:49 +0000
commitb37043115f92ac73bfe3a2939d40e00a12f9f215 (patch)
tree9c60531c1c95b3880273df544840c340610fb86e /t/pragma/warn
parentb6429b1b67c6f0e2a8a4aac1874df3fa87f9d71b (diff)
downloadperl-b37043115f92ac73bfe3a2939d40e00a12f9f215.tar.gz
rename t/pragma/warn-* to t/pragma/warn/*, be 8.3-friendly
p4raw-id: //depot/perl@1820
Diffstat (limited to 't/pragma/warn')
-rw-r--r--t/pragma/warn/1global186
-rw-r--r--t/pragma/warn/2use291
-rw-r--r--t/pragma/warn/3both66
-rw-r--r--t/pragma/warn/4lint112
-rw-r--r--t/pragma/warn/5nolint96
-rw-r--r--t/pragma/warn/doio94
-rw-r--r--t/pragma/warn/gv40
-rw-r--r--t/pragma/warn/mg25
-rw-r--r--t/pragma/warn/op539
-rw-r--r--t/pragma/warn/perl12
-rw-r--r--t/pragma/warn/perly25
-rw-r--r--t/pragma/warn/pp85
-rw-r--r--t/pragma/warn/pp_ctl145
-rw-r--r--t/pragma/warn/pp_hot107
-rw-r--r--t/pragma/warn/pp_sys208
-rw-r--r--t/pragma/warn/regcomp53
-rw-r--r--t/pragma/warn/regexec57
-rw-r--r--t/pragma/warn/sv203
-rw-r--r--t/pragma/warn/taint25
-rw-r--r--t/pragma/warn/toke315
-rw-r--r--t/pragma/warn/universal11
-rw-r--r--t/pragma/warn/util21
22 files changed, 2716 insertions, 0 deletions
diff --git a/t/pragma/warn/1global b/t/pragma/warn/1global
new file mode 100644
index 0000000000..dca47e92ce
--- /dev/null
+++ b/t/pragma/warn/1global
@@ -0,0 +1,186 @@
+Check existing $^W functionality
+
+
+__END__
+
+# warnable code, warnings disabled
+$a =+ 3 ;
+EXPECT
+
+########
+-w
+# warnable code, warnings enabled via command line switch
+$a =+ 3 ;
+EXPECT
+Reversed += operator at - line 3.
+########
+#! perl -w
+# warnable code, warnings enabled via #! line
+$a =+ 3 ;
+EXPECT
+Reversed += operator at - line 3.
+########
+
+# warnable code, warnings enabled via compile time $^W
+BEGIN { $^W = 1 }
+$a =+ 3 ;
+EXPECT
+Reversed += operator at - line 4.
+########
+
+# compile-time warnable code, warnings enabled via runtime $^W
+# so no warning printed.
+$^W = 1 ;
+$a =+ 3 ;
+EXPECT
+
+########
+
+# warnable code, warnings enabled via runtime $^W
+$^W = 1 ;
+my $b ; chop $b ;
+EXPECT
+Use of uninitialized value at - line 4.
+########
+
+# warnings enabled at compile time, disabled at run time
+BEGIN { $^W = 1 }
+$^W = 0 ;
+my $b ; chop $b ;
+EXPECT
+
+########
+
+# warnings disabled at compile time, enabled at run time
+BEGIN { $^W = 0 }
+$^W = 1 ;
+my $b ; chop $b ;
+EXPECT
+Use of uninitialized value at - line 5.
+########
+-w
+--FILE-- abcd
+my $b ; chop $b ;
+1 ;
+--FILE--
+require "./abcd";
+EXPECT
+Use of uninitialized value at ./abcd line 1.
+########
+
+--FILE-- abcd
+my $b ; chop $b ;
+1 ;
+--FILE--
+#! perl -w
+require "./abcd";
+EXPECT
+Use of uninitialized value at ./abcd line 1.
+########
+
+--FILE-- abcd
+my $b ; chop $b ;
+1 ;
+--FILE--
+$^W =1 ;
+require "./abcd";
+EXPECT
+Use of uninitialized value at ./abcd line 1.
+########
+
+--FILE-- abcd
+$^W = 0;
+my $b ; chop $b ;
+1 ;
+--FILE--
+$^W =1 ;
+require "./abcd";
+EXPECT
+
+########
+
+--FILE-- abcd
+$^W = 1;
+1 ;
+--FILE--
+$^W =0 ;
+require "./abcd";
+my $b ; chop $b ;
+EXPECT
+Use of uninitialized value at - line 3.
+########
+
+$^W = 1;
+eval 'my $b ; chop $b ;' ;
+print $@ ;
+EXPECT
+Use of uninitialized value at (eval 1) line 1.
+########
+
+eval '$^W = 1;' ;
+print $@ ;
+my $b ; chop $b ;
+EXPECT
+Use of uninitialized value at - line 4.
+########
+
+eval {$^W = 1;} ;
+print $@ ;
+my $b ; chop $b ;
+EXPECT
+Use of uninitialized value at - line 4.
+########
+
+{
+ local ($^W) = 1;
+}
+my $b ; chop $b ;
+EXPECT
+
+########
+
+my $a ; chop $a ;
+{
+ local ($^W) = 1;
+ my $b ; chop $b ;
+}
+my $c ; chop $c ;
+EXPECT
+Use of uninitialized value at - line 5.
+########
+-w
+-e undef
+EXPECT
+Use of uninitialized value at - line 2.
+########
+
+$^W = 1 + 2 ;
+EXPECT
+
+########
+
+$^W = $a ;
+EXPECT
+
+########
+
+sub fred {}
+$^W = fred() ;
+EXPECT
+
+########
+
+sub fred { my $b ; chop $b ;}
+{ local $^W = 0 ;
+ fred() ;
+}
+EXPECT
+
+########
+
+sub fred { my $b ; chop $b ;}
+{ local $^W = 1 ;
+ fred() ;
+}
+EXPECT
+Use of uninitialized value at - line 2.
diff --git a/t/pragma/warn/2use b/t/pragma/warn/2use
new file mode 100644
index 0000000000..764a843192
--- /dev/null
+++ b/t/pragma/warn/2use
@@ -0,0 +1,291 @@
+Check lexical warning functionality
+
+TODO
+ check that the warning hierarchy works.
+
+__END__
+
+# check illegal category is caught
+use warning 'blah' ;
+EXPECT
+unknown warning category 'blah' at - line 3
+BEGIN failed--compilation aborted at - line 3.
+########
+
+# Check compile time scope of pragma
+use warning 'deprecated' ;
+{
+ no warning ;
+ 1 if $a EQ $b ;
+}
+1 if $a EQ $b ;
+EXPECT
+Use of EQ is deprecated at - line 8.
+########
+
+# Check compile time scope of pragma
+no warning;
+{
+ use warning 'deprecated' ;
+ 1 if $a EQ $b ;
+}
+1 if $a EQ $b ;
+EXPECT
+Use of EQ is deprecated at - line 6.
+########
+
+# Check runtime scope of pragma
+use warning 'uninitialized' ;
+{
+ no warning ;
+ my $b ; chop $b ;
+}
+my $b ; chop $b ;
+EXPECT
+Use of uninitialized value at - line 8.
+########
+
+# Check runtime scope of pragma
+no warning ;
+{
+ use warning 'uninitialized' ;
+ my $b ; chop $b ;
+}
+my $b ; chop $b ;
+EXPECT
+Use of uninitialized value at - line 6.
+########
+
+# Check runtime scope of pragma
+no warning ;
+{
+ use warning 'uninitialized' ;
+ $a = sub { my $b ; chop $b ; }
+}
+&$a ;
+EXPECT
+Use of uninitialized value at - line 6.
+########
+
+use warning 'deprecated' ;
+1 if $a EQ $b ;
+EXPECT
+Use of EQ is deprecated at - line 3.
+########
+
+--FILE-- abc
+1 if $a EQ $b ;
+1;
+--FILE--
+use warning 'deprecated' ;
+require "./abc";
+EXPECT
+
+########
+
+--FILE-- abc
+use warning 'deprecated' ;
+1;
+--FILE--
+require "./abc";
+1 if $a EQ $b ;
+EXPECT
+
+########
+
+--FILE-- abc
+use warning 'deprecated' ;
+1 if $a EQ $b ;
+1;
+--FILE--
+use warning 'uninitialized' ;
+require "./abc";
+my $a ; chop $a ;
+EXPECT
+Use of EQ is deprecated at ./abc line 2.
+Use of uninitialized value at - line 3.
+########
+
+--FILE-- abc.pm
+use warning 'deprecated' ;
+1 if $a EQ $b ;
+1;
+--FILE--
+use warning 'uninitialized' ;
+use abc;
+my $a ; chop $a ;
+EXPECT
+Use of EQ is deprecated at abc.pm line 2.
+Use of uninitialized value at - line 3.
+########
+
+# Check scope of pragma with eval
+no warning ;
+eval {
+ my $b ; chop $b ;
+}; print STDERR $@ ;
+my $b ; chop $b ;
+EXPECT
+
+########
+
+# Check scope of pragma with eval
+no warning ;
+eval {
+ use warning 'uninitialized' ;
+ my $b ; chop $b ;
+}; print STDERR $@ ;
+my $b ; chop $b ;
+EXPECT
+Use of uninitialized value at - line 6.
+########
+
+# Check scope of pragma with eval
+use warning 'uninitialized' ;
+eval {
+ my $b ; chop $b ;
+}; print STDERR $@ ;
+my $b ; chop $b ;
+EXPECT
+Use of uninitialized value at - line 5.
+Use of uninitialized value at - line 7.
+########
+
+# Check scope of pragma with eval
+use warning 'uninitialized' ;
+eval {
+ no warning ;
+ my $b ; chop $b ;
+}; print STDERR $@ ;
+my $b ; chop $b ;
+EXPECT
+Use of uninitialized value at - line 8.
+########
+
+# Check scope of pragma with eval
+no warning ;
+eval {
+ 1 if $a EQ $b ;
+}; print STDERR $@ ;
+1 if $a EQ $b ;
+EXPECT
+
+########
+
+# Check scope of pragma with eval
+no warning ;
+eval {
+ use warning 'deprecated' ;
+ 1 if $a EQ $b ;
+}; print STDERR $@ ;
+1 if $a EQ $b ;
+EXPECT
+Use of EQ is deprecated at - line 6.
+########
+
+# Check scope of pragma with eval
+use warning 'deprecated' ;
+eval {
+ 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.
+########
+
+# Check scope of pragma with eval
+use warning 'deprecated' ;
+eval {
+ no warning ;
+ 1 if $a EQ $b ;
+}; print STDERR $@ ;
+1 if $a EQ $b ;
+EXPECT
+Use of EQ is deprecated at - line 8.
+########
+
+# Check scope of pragma with eval
+no warning ;
+eval '
+ my $b ; chop $b ;
+'; print STDERR $@ ;
+my $b ; chop $b ;
+EXPECT
+
+########
+
+# Check scope of pragma with eval
+no warning ;
+eval q[
+ use warning 'uninitialized' ;
+ my $b ; chop $b ;
+]; print STDERR $@;
+my $b ; chop $b ;
+EXPECT
+Use of uninitialized value at (eval 1) line 3.
+########
+
+# Check scope of pragma with eval
+use warning 'uninitialized' ;
+eval '
+ my $b ; chop $b ;
+'; print STDERR $@ ;
+my $b ; chop $b ;
+EXPECT
+Use of uninitialized value at (eval 1) line 2.
+Use of uninitialized value at - line 7.
+########
+
+# Check scope of pragma with eval
+use warning 'uninitialized' ;
+eval '
+ no warning ;
+ my $b ; chop $b ;
+'; print STDERR $@ ;
+my $b ; chop $b ;
+EXPECT
+Use of uninitialized value at - line 8.
+########
+
+# Check scope of pragma with eval
+no warning ;
+eval '
+ 1 if $a EQ $b ;
+'; print STDERR $@ ;
+1 if $a EQ $b ;
+EXPECT
+
+########
+
+# Check scope of pragma with eval
+no warning ;
+eval q[
+ use warning 'deprecated' ;
+ 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 warning 'deprecated' ;
+eval '
+ 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 (eval 1) line 2.
+########
+
+# Check scope of pragma with eval
+use warning 'deprecated' ;
+eval '
+ no warning ;
+ 1 if $a EQ $b ;
+'; print STDERR $@;
+1 if $a EQ $b ;
+EXPECT
+Use of EQ is deprecated at - line 8.
diff --git a/t/pragma/warn/3both b/t/pragma/warn/3both
new file mode 100644
index 0000000000..7c3260126b
--- /dev/null
+++ b/t/pragma/warn/3both
@@ -0,0 +1,66 @@
+Check interaction of $^W and lexical
+
+__END__
+
+# Check interaction of $^W and use warning
+sub fred {
+ use warning ;
+ my $b ;
+ chop $b ;
+}
+{ local $^W = 0 ;
+ fred() ;
+}
+
+EXPECT
+Use of uninitialized value at - line 6.
+########
+
+# Check interaction of $^W and use warning
+sub fred {
+ no warning ;
+ my $b ;
+ chop $b ;
+}
+{ local $^W = 1 ;
+ fred() ;
+}
+
+EXPECT
+Use of uninitialized value at - line 6.
+########
+
+# Check interaction of $^W and use warning
+use warning ;
+$^W = 1 ;
+my $b ;
+chop $b ;
+EXPECT
+Use of uninitialized value at - line 6.
+########
+
+# Check interaction of $^W and use warning
+$^W = 1 ;
+use warning ;
+my $b ;
+chop $b ;
+EXPECT
+Use of uninitialized value at - line 6.
+########
+
+# Check interaction of $^W and use warning
+$^W = 1 ;
+no warning ;
+my $b ;
+chop $b ;
+EXPECT
+Use of uninitialized value at - line 6.
+########
+
+# Check interaction of $^W and use warning
+no warning ;
+$^W = 1 ;
+my $b ;
+chop $b ;
+EXPECT
+Use of uninitialized value at - line 6.
diff --git a/t/pragma/warn/4lint b/t/pragma/warn/4lint
new file mode 100644
index 0000000000..87cd7dc967
--- /dev/null
+++ b/t/pragma/warn/4lint
@@ -0,0 +1,112 @@
+Check lint
+
+__END__
+-W
+# lint: check compile time $^W is zapped
+BEGIN { $^W = 0 ;}
+$a = $b = 1 ;
+$a = 1 if $a EQ $b ;
+close STDIN ; print STDIN "abc" ;
+EXPECT
+Use of EQ is deprecated at - line 5.
+print on closed filehandle main::STDIN at - line 6.
+########
+-W
+# lint: check runtime $^W is zapped
+$^W = 0 ;
+close STDIN ; print STDIN "abc" ;
+EXPECT
+print on closed filehandle main::STDIN at - line 4.
+########
+-W
+# lint: check runtime $^W is zapped
+{
+ $^W = 0 ;
+ close STDIN ; print STDIN "abc" ;
+}
+EXPECT
+print on closed filehandle main::STDIN at - line 5.
+########
+-W
+# lint: check "no warning" is zapped
+no warning ;
+$a = $b = 1 ;
+$a = 1 if $a EQ $b ;
+close STDIN ; print STDIN "abc" ;
+EXPECT
+Use of EQ is deprecated at - line 5.
+print on closed filehandle main::STDIN at - line 6.
+########
+-W
+# lint: check "no warning" is zapped
+{
+ no warning ;
+ close STDIN ; print STDIN "abc" ;
+}
+EXPECT
+print on closed filehandle main::STDIN at - line 5.
+########
+-Ww
+# lint: check combination of -w and -W
+{
+ $^W = 0 ;
+ close STDIN ; print STDIN "abc" ;
+}
+EXPECT
+print on closed filehandle main::STDIN at - line 5.
+########
+-W
+--FILE-- abc.pm
+no warning 'deprecated' ;
+my ($a, $b) = (0,0);
+1 if $a EQ $b ;
+1;
+--FILE--
+no warning 'uninitialized' ;
+use abc;
+my $a ; chop $a ;
+EXPECT
+Use of EQ is deprecated at abc.pm line 3.
+Use of uninitialized value at - line 3.
+########
+-W
+--FILE-- abc
+no warning 'deprecated' ;
+my ($a, $b) = (0,0);
+1 if $a EQ $b ;
+1;
+--FILE--
+no warning 'uninitialized' ;
+require "./abc";
+my $a ; chop $a ;
+EXPECT
+Use of EQ is deprecated at ./abc line 3.
+Use of uninitialized value at - line 3.
+########
+-W
+--FILE-- abc.pm
+BEGIN {$^W = 0}
+my ($a, $b) = (0,0);
+1 if $a EQ $b ;
+1;
+--FILE--
+$^W = 0 ;
+use abc;
+my $a ; chop $a ;
+EXPECT
+Use of EQ is deprecated at abc.pm line 3.
+Use of uninitialized value at - line 3.
+########
+-W
+--FILE-- abc
+BEGIN {$^W = 0}
+my ($a, $b) = (0,0);
+1 if $a EQ $b ;
+1;
+--FILE--
+$^W = 0 ;
+require "./abc";
+my $a ; chop $a ;
+EXPECT
+Use of EQ is deprecated at ./abc line 3.
+Use of uninitialized value at - line 3.
diff --git a/t/pragma/warn/5nolint b/t/pragma/warn/5nolint
new file mode 100644
index 0000000000..979423e87e
--- /dev/null
+++ b/t/pragma/warn/5nolint
@@ -0,0 +1,96 @@
+Check anti-lint
+
+__END__
+-X
+# nolint: check compile time $^W is zapped
+BEGIN { $^W = 1 ;}
+$a = $b = 1 ;
+$a = 1 if $a EQ $b ;
+close STDIN ; print STDIN "abc" ;
+EXPECT
+########
+-X
+# nolint: check runtime $^W is zapped
+$^W = 1 ;
+close STDIN ; print STDIN "abc" ;
+EXPECT
+########
+-X
+# nolint: check runtime $^W is zapped
+{
+ $^W = 1 ;
+ close STDIN ; print STDIN "abc" ;
+}
+EXPECT
+########
+-X
+# nolint: check "no warning" is zapped
+use warning ;
+$a = $b = 1 ;
+$a = 1 if $a EQ $b ;
+close STDIN ; print STDIN "abc" ;
+EXPECT
+########
+-X
+# nolint: check "no warning" is zapped
+{
+ use warning ;
+ close STDIN ; print STDIN "abc" ;
+}
+EXPECT
+########
+-Xw
+# nolint: check combination of -w and -X
+{
+ $^W = 1 ;
+ close STDIN ; print STDIN "abc" ;
+}
+EXPECT
+########
+-X
+--FILE-- abc.pm
+use warning 'deprecated' ;
+my ($a, $b) = (0,0);
+1 if $a EQ $b ;
+1;
+--FILE--
+use warning 'uninitialized' ;
+use abc;
+my $a ; chop $a ;
+EXPECT
+########
+-X
+--FILE-- abc
+use warning 'deprecated' ;
+my ($a, $b) = (0,0);
+1 if $a EQ $b ;
+1;
+--FILE--
+use warning 'uninitialized' ;
+require "./abc";
+my $a ; chop $a ;
+EXPECT
+########
+-X
+--FILE-- abc.pm
+BEGIN {$^W = 1}
+my ($a, $b) = (0,0);
+1 if $a EQ $b ;
+1;
+--FILE--
+$^W = 1 ;
+use abc;
+my $a ; chop $a ;
+EXPECT
+########
+-X
+--FILE-- abc
+BEGIN {$^W = 1}
+my ($a, $b) = (0,0);
+1 if $a EQ $b ;
+1;
+--FILE--
+$^W = 1 ;
+require "./abc";
+my $a ; chop $a ;
+EXPECT
diff --git a/t/pragma/warn/doio b/t/pragma/warn/doio
new file mode 100644
index 0000000000..af14f42272
--- /dev/null
+++ b/t/pragma/warn/doio
@@ -0,0 +1,94 @@
+ doio.c AOK
+
+ Can't do bidirectional pipe
+ open(F, "| true |");
+
+ warn(warn_nl, "open");
+ open(F, "true\ncd")
+
+ Close on unopened file <%s>
+ $a = "fred";close($a)
+
+ tell() on unopened file
+ $a = "fred";$a = tell($a)
+
+ seek() on unopened file
+ $a = "fred";$a = seek($a,1,1)
+
+ sysseek() on unopened file
+ $a = "fred";$a = seek($a,1,1)
+
+ warn(warn_uninit);
+ print $a ;
+
+ Stat on unopened file <%s>
+ close STDIN ; -x STDIN ;
+
+ warn(warn_nl, "stat");
+ stat "ab\ncd"
+
+ warn(warn_nl, "lstat");
+ lstat "ab\ncd"
+
+ Can't exec \"%s\": %s
+
+ Can't exec \"%s\": %s
+
+
+__END__
+# doio.c
+use warning 'io' ;
+open(F, "|$^X -e 1|")
+EXPECT
+Can't do bidirectional pipe at - line 3.
+########
+# doio.c
+use warning 'io' ;
+open(F, "<true\ncd")
+EXPECT
+Unsuccessful open on filename containing newline at - line 3.
+########
+# doio.c
+use warning 'io' ;
+close STDIN ;
+tell(STDIN);
+$a = seek(STDIN,1,1);
+$a = sysseek(STDIN,1,1);
+-x STDIN ;
+EXPECT
+tell() on unopened file at - line 4.
+seek() on unopened file at - line 5.
+sysseek() on unopened file at - line 6.
+Stat on unopened file <STDIN> at - line 7.
+########
+# doio.c
+use warning 'uninitialized' ;
+print $a ;
+EXPECT
+Use of uninitialized value at - line 3.
+########
+# doio.c
+use warning 'io' ;
+
+EXPECT
+
+########
+# doio.c
+use warning 'io' ;
+stat "ab\ncd";
+lstat "ab\ncd";
+EXPECT
+Unsuccessful stat on filename containing newline at - line 3.
+Unsuccessful stat on filename containing newline at - line 4.
+########
+# doio.c
+use warning 'io' ;
+exec "lskdjfalksdjfdjfkls","" ;
+EXPECT
+Can't exec "lskdjfalksdjfdjfkls": No such file or directory at - line 3.
+########
+# doio.c
+use warning 'io' ;
+exec "lskdjfalksdjfdjfkls", "abc" ;
+EXPECT
+Can't exec "lskdjfalksdjfdjfkls": No such file or directory at - line 3.
diff --git a/t/pragma/warn/gv b/t/pragma/warn/gv
new file mode 100644
index 0000000000..bd442b97d6
--- /dev/null
+++ b/t/pragma/warn/gv
@@ -0,0 +1,40 @@
+ gv.c AOK
+
+ Can't locate package %s for @%s::ISA
+ @ISA = qw(Fred); joe()
+
+ Use of inherited AUTOLOAD for non-method %s::%.*s() is deprecated
+ sub Other::AUTOLOAD { 1 } sub Other::fred {}
+ @ISA = qw(Other) ;
+ fred() ;
+
+ Use of $# is deprecated
+ Use of $* is deprecated
+
+ $a = ${"#"} ;
+ $a = ${"*"} ;
+
+
+__END__
+# gv.c
+use warning 'misc' ;
+@ISA = qw(Fred); joe()
+EXPECT
+Can't locate package Fred for @main::ISA at - line 3.
+Undefined subroutine &main::joe called at - line 3.
+########
+# gv.c
+sub Other::AUTOLOAD { 1 } sub Other::fred {}
+@ISA = qw(Other) ;
+use warning 'deprecated' ;
+fred() ;
+EXPECT
+Use of inherited AUTOLOAD for non-method main::fred() is deprecated at - line 5.
+########
+# gv.c
+use warning 'deprecated' ;
+$a = ${"#"};
+$a = ${"*"};
+EXPECT
+Use of $# is deprecated at - line 3.
+Use of $* is deprecated at - line 4.
diff --git a/t/pragma/warn/mg b/t/pragma/warn/mg
new file mode 100644
index 0000000000..44e7634952
--- /dev/null
+++ b/t/pragma/warn/mg
@@ -0,0 +1,25 @@
+ mg.c AOK
+
+ No such signal: SIG%s
+ $SIG{FRED} = sub {}
+
+ SIG%s handler \"%s\" not defined.
+ $SIG{"INT"} = "ok3"; kill "INT",$$;
+
+
+__END__
+# mg.c
+use warning 'signal' ;
+$SIG{FRED} = sub {};
+EXPECT
+No such signal: SIGFRED at - line 3.
+########
+# mg.c
+use warning 'signal' ;
+if ($^O eq 'MSWin32') {
+ print "SKIPPED\n# win32, can't kill() to raise()\n"; exit;
+}
+$|=1;
+$SIG{"INT"} = "fred"; kill "INT",$$;
+EXPECT
+SIGINT handler "fred" not defined.
diff --git a/t/pragma/warn/op b/t/pragma/warn/op
new file mode 100644
index 0000000000..d0886edf58
--- /dev/null
+++ b/t/pragma/warn/op
@@ -0,0 +1,539 @@
+ op.c AOK
+
+ "my" variable %s masks earlier declaration in same scope
+ my $x;
+ my $x ;
+
+ Variable "%s" may be unavailable
+ sub x {
+ my $x;
+ sub y {
+ $x
+ }
+ }
+
+ Variable "%s" will not stay shared
+ sub x {
+ my $x;
+ sub y {
+ sub { $x }
+ }
+ }
+
+ Found = in conditional, should be ==
+ 1 if $a = 1 ;
+
+ Use of implicit split to @_ is deprecated
+ split ;
+
+ Use of implicit split to @_ is deprecated
+ $a = split ;
+
+ Useless use of time in void context
+ Useless use of a variable in void context
+ Useless use of a constant in void context
+ time ;
+ $a ;
+ "abc"
+
+ Applying %s to %s will act on scalar(%s)
+ my $a ; my @a = () ; my %a = () ; my $b = \@a ; my $c = \%a ;
+ @a =~ /abc/ ;
+ @a =~ s/a/b/ ;
+ @a =~ tr/a/b/ ;
+ @$b =~ /abc/ ;
+ @$b =~ s/a/b/ ;
+ @$b =~ tr/a/b/ ;
+ %a =~ /abc/ ;
+ %a =~ s/a/b/ ;
+ %a =~ tr/a/b/ ;
+ %$c =~ /abc/ ;
+ %$c =~ s/a/b/ ;
+ %$c =~ tr/a/b/ ;
+
+
+ Parens missing around "my" list at -e line 1.
+ my $a, $b = (1,2);
+
+ Parens missing around "local" list at -e line 1.
+ local $a, $b = (1,2);
+
+ Probable precedence problem on logical or at -e line 1.
+ use warning 'syntax'; my $x = print(ABC || 1);
+
+ Value of %s may be \"0\"; use \"defined\"
+ $x = 1 if $x = <FH> ;
+ $x = 1 while $x = <FH> ;
+
+ Subroutine fred redefined at -e line 1.
+ sub fred{1;} sub fred{1;}
+
+ Constant subroutine %s redefined
+ sub fred() {1;} sub fred() {1;}
+
+ Format FRED redefined at /tmp/x line 5.
+ format FRED =
+ .
+ format FRED =
+ .
+
+ Array @%s missing the @ in argument %d of %s()
+ push fred ;
+
+ Hash %%%s missing the %% in argument %d of %s()
+ keys joe ;
+
+ Statement unlikely to be reached
+ (Maybe you meant system() when you said exec()?
+ exec "true" ; my $a
+
+
+__END__
+# op.c
+use warning 'unsafe' ;
+my $x ;
+my $x ;
+EXPECT
+"my" variable $x masks earlier declaration in same scope at - line 4.
+########
+# op.c
+use warning 'unsafe' ;
+sub x {
+ my $x;
+ sub y {
+ $x
+ }
+ }
+EXPECT
+Variable "$x" will not stay shared at - line 7.
+########
+# op.c
+use warning 'unsafe' ;
+sub x {
+ my $x;
+ sub y {
+ sub { $x }
+ }
+ }
+EXPECT
+Variable "$x" may be unavailable at - line 6.
+########
+# op.c
+use warning 'syntax' ;
+1 if $a = 1 ;
+EXPECT
+Found = in conditional, should be == at - line 3.
+########
+# op.c
+use warning 'deprecated' ;
+split ;
+EXPECT
+Use of implicit split to @_ is deprecated at - line 3.
+########
+# op.c
+use warning 'deprecated' ;
+$a = split ;
+EXPECT
+Use of implicit split to @_ is deprecated at - line 3.
+########
+# op.c
+use warning 'void' ; close STDIN ;
+1 x 3 ; # OP_REPEAT
+ # OP_GVSV
+wantarray ; # OP_WANTARRAY
+ # OP_GV
+ # OP_PADSV
+ # OP_PADAV
+ # OP_PADHV
+ # OP_PADANY
+ # OP_AV2ARYLEN
+ref ; # OP_REF
+\@a ; # OP_REFGEN
+\$a ; # OP_SREFGEN
+defined $a ; # OP_DEFINED
+hex $a ; # OP_HEX
+oct $a ; # OP_OCT
+length $a ; # OP_LENGTH
+substr $a,1 ; # OP_SUBSTR
+vec $a,1,2 ; # OP_VEC
+index $a,1,2 ; # OP_INDEX
+rindex $a,1,2 ; # OP_RINDEX
+sprintf $a ; # OP_SPRINTF
+$a[0] ; # OP_AELEM
+ # OP_AELEMFAST
+@a[0] ; # OP_ASLICE
+#values %a ; # OP_VALUES
+#keys %a ; # OP_KEYS
+$a{0} ; # OP_HELEM
+@a{0} ; # OP_HSLICE
+unpack "a", "a" ; # OP_UNPACK
+pack $a,"" ; # OP_PACK
+join "" ; # OP_JOIN
+(@a)[0,1] ; # OP_LSLICE
+ # OP_ANONLIST
+ # OP_ANONHASH
+sort(1,2) ; # OP_SORT
+reverse(1,2) ; # OP_REVERSE
+ # OP_RANGE
+ # OP_FLIP
+(1 ..2) ; # OP_FLOP
+caller ; # OP_CALLER
+fileno STDIN ; # OP_FILENO
+eof STDIN ; # OP_EOF
+tell STDIN ; # OP_TELL
+readlink 1; # OP_READLINK
+time ; # OP_TIME
+localtime ; # OP_LOCALTIME
+gmtime ; # OP_GMTIME
+eval { getgrnam 1 }; # OP_GGRNAM
+eval { getgrgid 1 }; # OP_GGRGID
+eval { getpwnam 1 }; # OP_GPWNAM
+eval { getpwuid 1 }; # OP_GPWUID
+EXPECT
+Useless use of repeat in void context at - line 3.
+Useless use of wantarray in void context at - line 5.
+Useless use of reference-type operator in void context at - line 12.
+Useless use of reference constructor in void context at - line 13.
+Useless use of scalar ref constructor in void context at - line 14.
+Useless use of defined operator in void context at - line 15.
+Useless use of hex in void context at - line 16.
+Useless use of oct in void context at - line 17.
+Useless use of length in void context at - line 18.
+Useless use of substr in void context at - line 19.
+Useless use of vec in void context at - line 20.
+Useless use of index in void context at - line 21.
+Useless use of rindex in void context at - line 22.
+Useless use of sprintf in void context at - line 23.
+Useless use of array element in void context at - line 24.
+Useless use of array slice in void context at - line 26.
+Useless use of hash elem in void context at - line 29.
+Useless use of hash slice in void context at - line 30.
+Useless use of unpack in void context at - line 31.
+Useless use of pack in void context at - line 32.
+Useless use of join in void context at - line 33.
+Useless use of list slice in void context at - line 34.
+Useless use of sort in void context at - line 37.
+Useless use of reverse in void context at - line 38.
+Useless use of range (or flop) in void context at - line 41.
+Useless use of caller in void context at - line 42.
+Useless use of fileno in void context at - line 43.
+Useless use of eof in void context at - line 44.
+Useless use of tell in void context at - line 45.
+Useless use of readlink in void context at - line 46.
+Useless use of time in void context at - line 47.
+Useless use of localtime in void context at - line 48.
+Useless use of gmtime in void context at - line 49.
+Useless use of getgrnam in void context at - line 50.
+Useless use of getgrgid in void context at - line 51.
+Useless use of getpwnam in void context at - line 52.
+Useless use of getpwuid in void context at - line 53.
+########
+# op.c
+use warning 'void' ;
+use Config ;
+BEGIN {
+ if ( ! $Config{d_telldir}) {
+ print <<EOM ;
+SKIPPED
+# telldir not present
+EOM
+ exit
+ }
+}
+telldir 1 ; # OP_TELLDIR
+EXPECT
+Useless use of telldir in void context at - line 13.
+########
+# op.c
+use warning 'void' ;
+use Config ;
+BEGIN {
+ if ( ! $Config{d_getppid}) {
+ print <<EOM ;
+SKIPPED
+# getppid not present
+EOM
+ exit
+ }
+}
+getppid ; # OP_GETPPID
+EXPECT
+Useless use of getppid in void context at - line 13.
+########
+# op.c
+use warning 'void' ;
+use Config ;
+BEGIN {
+ if ( ! $Config{d_getpgrp}) {
+ print <<EOM ;
+SKIPPED
+# getpgrp not present
+EOM
+ exit
+ }
+}
+getpgrp ; # OP_GETPGRP
+EXPECT
+Useless use of getpgrp in void context at - line 13.
+########
+# op.c
+use warning 'void' ;
+use Config ;
+BEGIN {
+ if ( ! $Config{d_times}) {
+ print <<EOM ;
+SKIPPED
+# times not present
+EOM
+ exit
+ }
+}
+times ; # OP_TMS
+EXPECT
+Useless use of times in void context at - line 13.
+########
+# op.c
+use warning 'void' ;
+use Config ;
+BEGIN {
+ if ( ! $Config{d_getprior}) {
+ print <<EOM ;
+SKIPPED
+# getpriority not present
+EOM
+ exit
+ }
+}
+getpriority 1,2; # OP_GETPRIORITY
+EXPECT
+Useless use of getpriority in void context at - line 13.
+########
+# op.c
+use warning 'void' ;
+use Config ;
+BEGIN {
+ if ( ! $Config{d_getlogin}) {
+ print <<EOM ;
+SKIPPED
+# getlogin not present
+EOM
+ exit
+ }
+}
+getlogin ; # OP_GETLOGIN
+EXPECT
+Useless use of getlogin in void context at - line 13.
+########
+# op.c
+use warning 'void' ;
+use Config ; BEGIN {
+if ( ! $Config{d_socket}) {
+ print <<EOM ;
+SKIPPED
+# getsockname not present
+# getpeername not present
+# gethostbyname not present
+# gethostbyaddr not present
+# gethostent not present
+# getnetbyname not present
+# getnetbyaddr not present
+# getnetent not present
+# getprotobyname not present
+# getprotobynumber not present
+# getprotoent not present
+# getservbyname not present
+# getservbyport not present
+# getservent not present
+EOM
+ exit
+} }
+getsockname STDIN ; # OP_GETSOCKNAME
+getpeername STDIN ; # OP_GETPEERNAME
+gethostbyname 1 ; # OP_GHBYNAME
+gethostbyaddr 1,2; # OP_GHBYADDR
+gethostent ; # OP_GHOSTENT
+getnetbyname 1 ; # OP_GNBYNAME
+getnetbyaddr 1,2 ; # OP_GNBYADDR
+getnetent ; # OP_GNETENT
+getprotobyname 1; # OP_GPBYNAME
+getprotobynumber 1; # OP_GPBYNUMBER
+getprotoent ; # OP_GPROTOENT
+getservbyname 1,2; # OP_GSBYNAME
+getservbyport 1,2; # OP_GSBYPORT
+getservent ; # OP_GSERVENT
+INIT {
+ # some functions may not be there, so we exit without running
+ exit;
+}
+EXPECT
+Useless use of getsockname in void context at - line 24.
+Useless use of getpeername in void context at - line 25.
+Useless use of gethostbyname in void context at - line 26.
+Useless use of gethostbyaddr in void context at - line 27.
+Useless use of gethostent in void context at - line 28.
+Useless use of getnetbyname in void context at - line 29.
+Useless use of getnetbyaddr in void context at - line 30.
+Useless use of getnetent in void context at - line 31.
+Useless use of getprotobyname in void context at - line 32.
+Useless use of getprotobynumber in void context at - line 33.
+Useless use of getprotoent in void context at - line 34.
+Useless use of getservbyname in void context at - line 35.
+Useless use of getservbyport in void context at - line 36.
+Useless use of getservent in void context at - line 37.
+########
+# op.c
+use warning 'void' ;
+*a ; # OP_RV2GV
+$a ; # OP_RV2SV
+@a ; # OP_RV2AV
+%a ; # OP_RV2HV
+EXPECT
+Useless use of a variable in void context at - line 3.
+Useless use of a variable in void context at - line 4.
+Useless use of a variable in void context at - line 5.
+Useless use of a variable in void context at - line 6.
+########
+# op.c
+use warning 'void' ;
+"abc"; # OP_CONST
+7 ; # OP_CONST
+EXPECT
+Useless use of a constant in void context at - line 3.
+Useless use of a constant in void context at - line 4.
+########
+# op.c
+use warning 'unsafe' ;
+my $a ; my @a = () ; my %a = () ; my $b = \@a ; my $c = \%a ;
+@a =~ /abc/ ;
+@a =~ s/a/b/ ;
+@a =~ tr/a/b/ ;
+@$b =~ /abc/ ;
+@$b =~ s/a/b/ ;
+@$b =~ tr/a/b/ ;
+%a =~ /abc/ ;
+%a =~ s/a/b/ ;
+%a =~ tr/a/b/ ;
+%$c =~ /abc/ ;
+%$c =~ s/a/b/ ;
+%$c =~ tr/a/b/ ;
+EXPECT
+Applying pattern match to @array will act on scalar(@array) at - line 4.
+Applying substitution to @array will act on scalar(@array) at - line 5.
+Can't modify private array in substitution at - line 5, near "s/a/b/ ;"
+Applying character translation to @array will act on scalar(@array) at - line 6.
+Applying pattern match to @array will act on scalar(@array) at - line 7.
+Applying substitution to @array will act on scalar(@array) at - line 8.
+Applying character translation to @array will act on scalar(@array) at - line 9.
+Applying pattern match to %hash will act on scalar(%hash) at - line 10.
+Applying substitution to %hash will act on scalar(%hash) at - line 11.
+Applying character translation to %hash will act on scalar(%hash) at - line 12.
+Applying pattern match to %hash will act on scalar(%hash) at - line 13.
+Applying substitution to %hash will act on scalar(%hash) at - line 14.
+Applying character translation to %hash will act on scalar(%hash) at - line 15.
+Execution of - aborted due to compilation errors.
+########
+# op.c
+use warning 'syntax' ;
+my $a, $b = (1,2);
+EXPECT
+Parens missing around "my" list at - line 3.
+########
+# op.c
+use warning 'syntax' ;
+local $a, $b = (1,2);
+EXPECT
+Parens missing around "local" list at - line 3.
+########
+# op.c
+use warning 'syntax' ;
+print (ABC || 1) ;
+EXPECT
+Probable precedence problem on logical or at - line 3.
+########
+--FILE-- abc
+
+--FILE--
+# op.c
+use warning 'unsafe' ;
+open FH, "<abc" ;
+$x = 1 if $x = <FH> ;
+EXPECT
+Value of <HANDLE> construct can be "0"; test with defined() at - line 4.
+########
+# op.c
+use warning 'unsafe' ;
+opendir FH, "." ;
+$x = 1 if $x = readdir FH ;
+closedir FH ;
+EXPECT
+Value of readdir() operator can be "0"; test with defined() at - line 4.
+########
+# op.c
+use warning 'unsafe' ;
+$x = 1 if $x = <*> ;
+EXPECT
+Value of glob construct can be "0"; test with defined() at - line 3.
+########
+# op.c
+use warning 'unsafe' ;
+%a = (1,2,3,4) ;
+$x = 1 if $x = each %a ;
+EXPECT
+Value of each() operator can be "0"; test with defined() at - line 4.
+########
+# op.c
+use warning 'unsafe' ;
+$x = 1 while $x = <*> and 0 ;
+EXPECT
+Value of glob construct can be "0"; test with defined() at - line 3.
+########
+# op.c
+use warning 'unsafe' ;
+opendir FH, "." ;
+$x = 1 while $x = readdir FH and 0 ;
+closedir FH ;
+EXPECT
+Value of readdir() operator can be "0"; test with defined() at - line 4.
+########
+# op.c
+use warning 'redefine' ;
+sub fred {}
+sub fred {}
+EXPECT
+Subroutine fred redefined at - line 4.
+########
+# op.c
+use warning 'redefine' ;
+sub fred () { 1 }
+sub fred () { 1 }
+EXPECT
+Constant subroutine fred redefined at - line 4.
+########
+# op.c
+use warning 'redefine' ;
+format FRED =
+.
+format FRED =
+.
+EXPECT
+Format FRED redefined at - line 5.
+########
+# op.c
+use warning 'syntax' ;
+push FRED;
+EXPECT
+Array @FRED missing the @ in argument 1 of push() at - line 3.
+########
+# op.c
+use warning 'syntax' ;
+@a = keys FRED ;
+EXPECT
+Hash %FRED missing the % in argument 1 of keys() at - line 3.
+########
+# op.c
+use warning 'syntax' ;
+exec "$^X -e 1" ;
+my $a
+EXPECT
+Statement unlikely to be reached at - line 4.
+(Maybe you meant system() when you said exec()?)
diff --git a/t/pragma/warn/perl b/t/pragma/warn/perl
new file mode 100644
index 0000000000..5211990902
--- /dev/null
+++ b/t/pragma/warn/perl
@@ -0,0 +1,12 @@
+ perl.c AOK
+
+ gv_check(defstash)
+ Name \"%s::%s\" used only once: possible typo
+
+
+__END__
+# perl.c
+use warning 'once' ;
+$x = 3 ;
+EXPECT
+Name "main::x" used only once: possible typo at - line 3.
diff --git a/t/pragma/warn/perly b/t/pragma/warn/perly
new file mode 100644
index 0000000000..fd420d3b22
--- /dev/null
+++ b/t/pragma/warn/perly
@@ -0,0 +1,25 @@
+ perly.y AOK
+
+ dep() => deprecate("\"do\" to call subroutines")
+ Use of "do" to call subroutines is deprecated
+
+ sub fred {} do fred()
+ sub fred {} do fred(1)
+ sub fred {} $a = "fred" ; do $a()
+ sub fred {} $a = "fred" ; do $a(1)
+
+
+__END__
+# perly.y
+use warning 'deprecated' ;
+sub fred {}
+do fred() ;
+do fred(1) ;
+$a = "fred" ;
+do $a() ;
+do $a(1) ;
+EXPECT
+Use of "do" to call subroutines is deprecated at - line 4.
+Use of "do" to call subroutines is deprecated at - line 5.
+Use of "do" to call subroutines is deprecated at - line 7.
+Use of "do" to call subroutines is deprecated at - line 8.
diff --git a/t/pragma/warn/pp b/t/pragma/warn/pp
new file mode 100644
index 0000000000..7a3b28991c
--- /dev/null
+++ b/t/pragma/warn/pp
@@ -0,0 +1,85 @@
+ pp.c TODO
+
+ substr outside of string
+ $a = "ab" ; $a = substr($a, 4,5)
+
+ Attempt to use reference as lvalue in substr
+ $a = "ab" ; $b = \$a ; substr($b, 1,1) = $b
+
+ uninitialized in pp_rv2gv()
+ my *b = *{ undef()}
+
+ uninitialized in pp_rv2sv()
+ my $a = undef ; my $b = $$a
+
+ Odd number of elements in hash list
+ my $a = { 1,2,3 } ;
+
+ Invalid type in unpack: '%c
+ my $A = pack ("A,A", 1,2) ;
+ my @A = unpack ("A,A", "22") ;
+
+ Attempt to pack pointer to temporary value
+ pack("p", "abc") ;
+
+ Explicit blessing to '' (assuming package main)
+ bless \[], "";
+
+ Constant subroutine %s undefined <<<
+ Constant subroutine (anonymous) undefined <<<
+
+__END__
+# pp.c
+use warning 'substr' ;
+$a = "ab" ;
+$a = substr($a, 4,5)
+EXPECT
+substr outside of string at - line 4.
+########
+# pp.c
+use warning 'substr' ;
+$a = "ab" ;
+$b = \$a ;
+substr($b, 1,1) = "ab" ;
+EXPECT
+Attempt to use reference as lvalue in substr at - line 5.
+########
+# pp.c
+use warning 'uninitialized' ;
+# TODO
+EXPECT
+
+########
+# pp.c
+use warning 'unsafe' ;
+my $a = { 1,2,3};
+EXPECT
+Odd number of elements in hash assignment at - line 3.
+########
+# pp.c
+use warning 'unsafe' ;
+my @a = unpack ("A,A", "22") ;
+my $a = pack ("A,A", 1,2) ;
+EXPECT
+Invalid type in unpack: ',' at - line 3.
+Invalid type in pack: ',' at - line 4.
+########
+# pp.c
+use warning 'uninitialized' ;
+my $a = undef ;
+my $b = $$a
+EXPECT
+Use of uninitialized value at - line 4.
+########
+# pp.c
+use warning 'unsafe' ;
+sub foo { my $a = "a"; return $a . $a++ . $a++ }
+my $a = pack("p", &foo) ;
+EXPECT
+Attempt to pack pointer to temporary value at - line 4.
+########
+# pp.c
+use warning 'unsafe' ;
+bless \[], "" ;
+EXPECT
+Explicit blessing to '' (assuming package main) at - line 3.
diff --git a/t/pragma/warn/pp_ctl b/t/pragma/warn/pp_ctl
new file mode 100644
index 0000000000..e017d8a0a8
--- /dev/null
+++ b/t/pragma/warn/pp_ctl
@@ -0,0 +1,145 @@
+ pp_ctl.c AOK
+
+ Not enough format arguments
+ format STDOUT =
+ @<<< @<<<
+ $a
+ .
+ write;
+
+
+ Exiting substitution via %s
+ $_ = "abc" ;
+ while ($i ++ == 0)
+ {
+ s/ab/last/e ;
+ }
+
+ Exiting subroutine via %s
+ sub fred { last }
+ { fred() }
+
+ Exiting eval via %s
+ { eval "last" }
+
+ Exiting pseudo-block via %s
+ @a = (1,2) ; @b = sort { last } @a ;
+
+ Exiting substitution via %s
+ $_ = "abc" ;
+ last fred:
+ while ($i ++ == 0)
+ {
+ s/ab/last fred/e ;
+ }
+
+
+ Exiting subroutine via %s
+ sub fred { last joe }
+ joe: { fred() }
+
+ Exiting eval via %s
+ fred: { eval "last fred" }
+
+ Exiting pseudo-block via %s
+ @a = (1,2) ; fred: @b = sort { last fred } @a ;
+
+
+ Deep recursion on subroutine \"%s\"
+ sub fred
+ {
+ goto &fred() if $a++ < 200
+ }
+
+ goto &fred()
+
+
+__END__
+# pp_ctl.c
+use warning 'syntax' ;
+format STDOUT =
+@<<< @<<<
+1
+.
+write;
+EXPECT
+Not enough format arguments at - line 5.
+1
+########
+# pp_ctl.c
+use warning 'unsafe' ;
+$_ = "abc" ;
+
+while ($i ++ == 0)
+{
+ s/ab/last/e ;
+}
+EXPECT
+Exiting substitution via last at - line 7.
+########
+# pp_ctl.c
+use warning 'unsafe' ;
+sub fred { last }
+{ fred() }
+EXPECT
+Exiting subroutine via last at - line 3.
+########
+# pp_ctl.c
+use warning 'unsafe' ;
+{ eval "last" }
+print STDERR $@ ;
+EXPECT
+Exiting eval via last at (eval 1) line 1.
+########
+# pp_ctl.c
+use warning 'unsafe' ;
+@a = (1,2) ;
+@b = sort { last } @a ;
+EXPECT
+Exiting pseudo-block via last at - line 4.
+Can't "last" outside a block at - line 4.
+########
+# pp_ctl.c
+use warning 'unsafe' ;
+$_ = "abc" ;
+fred:
+while ($i ++ == 0)
+{
+ s/ab/last fred/e ;
+}
+EXPECT
+Exiting substitution via last at - line 7.
+########
+# pp_ctl.c
+use warning 'unsafe' ;
+sub fred { last joe }
+joe: { fred() }
+EXPECT
+Exiting subroutine via last at - line 3.
+########
+# pp_ctl.c
+use warning 'unsafe' ;
+joe: { eval "last joe" }
+print STDERR $@ ;
+EXPECT
+Exiting eval via last at (eval 1) line 2.
+########
+# pp_ctl.c
+use warning 'unsafe' ;
+@a = (1,2) ;
+fred: @b = sort { last fred } @a ;
+EXPECT
+Exiting pseudo-block via last at - line 4.
+Label not found for "last fred" at - line 4.
+########
+# pp_ctl.c
+use warning 'recursion' ;
+BEGIN { warn "PREFIX\n" ;}
+sub fred
+{
+ goto &fred() if $a++ < 200
+}
+
+goto &fred()
+EXPECT
+Deep recursion on subroutine "main::fred" at - line 6.
diff --git a/t/pragma/warn/pp_hot b/t/pragma/warn/pp_hot
new file mode 100644
index 0000000000..ab180949e7
--- /dev/null
+++ b/t/pragma/warn/pp_hot
@@ -0,0 +1,107 @@
+ pp_hot.c AOK
+
+ Filehandle %s never opened
+ $f = $a = "abc" ; print $f $a
+
+ Filehandle %s opened only for input
+ print STDIN "abc" ;
+
+
+ print on closed filehandle %s
+ close STDIN ; print STDIN "abc" ;
+
+ uninitialized
+ my $a = undef ; my @b = @$a
+
+ uninitialized
+ my $a = undef ; my %b = %$a
+
+ Odd number of elements in hash list
+ %X = (1,2,3) ;
+
+ Reference found where even-sized list expected
+ $X = [ 1 ..3 ];
+
+ Read on closed filehandle <%s>
+ close STDIN ; $a = <STDIN>;
+
+ Deep recursion on subroutine \"%s\"
+ sub fred { fred() if $a++ < 200} fred()
+
+ Deep recursion on anonymous subroutine
+ $a = sub { &$a if $a++ < 200} &$a
+
+__END__
+# pp_hot.c
+use warning 'unopened' ;
+$f = $a = "abc" ;
+print $f $a
+EXPECT
+Filehandle main::abc never opened at - line 4.
+########
+# pp_hot.c
+use warning 'io' ;
+print STDIN "anc";
+EXPECT
+Filehandle main::STDIN opened only for input at - line 3.
+########
+# pp_hot.c
+use warning 'closed' ;
+close STDIN ;
+print STDIN "anc";
+EXPECT
+print on closed filehandle main::STDIN at - line 4.
+########
+# pp_hot.c
+use warning 'uninitialized' ;
+my $a = undef ;
+my @b = @$a
+EXPECT
+Use of uninitialized value at - line 4.
+########
+# pp_hot.c
+use warning 'uninitialized' ;
+my $a = undef ;
+my %b = %$a
+EXPECT
+Use of uninitialized value at - line 4.
+########
+# pp_hot.c
+use warning 'unsafe' ;
+my %X ; %X = (1,2,3) ;
+EXPECT
+Odd number of elements in hash assignment at - line 3.
+########
+# pp_hot.c
+use warning 'unsafe' ;
+my %X ; %X = [1 .. 3] ;
+EXPECT
+Reference found where even-sized list expected at - line 3.
+########
+# pp_hot.c
+use warning 'closed' ;
+close STDIN ; $a = <STDIN> ;
+EXPECT
+Read on closed filehandle <STDIN> at - line 3.
+########
+# pp_hot.c
+use warning 'recursion' ;
+sub fred
+{
+ fred() if $a++ < 200
+}
+
+fred()
+EXPECT
+Deep recursion on subroutine "main::fred" at - line 5.
+########
+# pp_hot.c
+use warning 'recursion' ;
+$b = sub
+{
+ &$b if $a++ < 200
+} ;
+
+&$b ;
+EXPECT
+Deep recursion on anonymous subroutine at - line 5.
diff --git a/t/pragma/warn/pp_sys b/t/pragma/warn/pp_sys
new file mode 100644
index 0000000000..7588827744
--- /dev/null
+++ b/t/pragma/warn/pp_sys
@@ -0,0 +1,208 @@
+ pp_sys.c AOK
+
+ untie attempted while %d inner references still exist
+ sub TIESCALAR { bless [] } ; tie $a, 'main'; untie $a ;
+
+ Filehandle only opened for input
+ format STDIN =
+ .
+ write STDIN;
+
+ Write on closed filehandle
+ format STDIN =
+ .
+ close STDIN;
+ write STDIN ;
+
+ page overflow
+
+ Filehandle %s never opened
+ $a = "abc"; printf $a "fred"
+
+ Filehandle %s opened only for input
+ $a = "abc";
+ printf $a "fred"
+
+ printf on closed filehandle %s
+ close STDIN ;
+ printf STDIN "fred"
+
+ Syswrite on closed filehandle
+ close STDIN;
+ syswrite STDIN, "fred", 1;
+
+ Send on closed socket
+ close STDIN;
+ send STDIN, "fred", 1
+
+ bind() on closed fd
+ close STDIN;
+ bind STDIN, "fred" ;
+
+
+ connect() on closed fd
+ close STDIN;
+ connect STDIN, "fred" ;
+
+ listen() on closed fd
+ close STDIN;
+ listen STDIN, 2;
+
+ accept() on closed fd
+ close STDIN;
+ accept STDIN, "fred" ;
+
+ shutdown() on closed fd
+ close STDIN;
+ shutdown STDIN, 0;
+
+ [gs]etsockopt() on closed fd
+ close STDIN;
+ setsockopt STDIN, 1,2,3;
+ getsockopt STDIN, 1,2;
+
+ get{sock, peer}name() on closed fd
+ close STDIN;
+ getsockname STDIN;
+ getpeername STDIN;
+
+ warn(warn_nl, "stat");
+
+ Test on unopened file <%s>
+ close STDIN ; -T STDIN ;
+
+ warn(warn_nl, "open");
+ -T "abc\ndef" ;
+
+
+
+__END__
+# pp_sys.c
+use warning 'untie' ;
+sub TIESCALAR { bless [] } ;
+$b = tie $a, 'main';
+untie $a ;
+EXPECT
+untie attempted while 1 inner references still exist at - line 5.
+########
+# pp_sys.c
+use warning 'io' ;
+format STDIN =
+.
+write STDIN;
+EXPECT
+Filehandle only opened for input at - line 5.
+########
+# pp_sys.c
+use warning 'closed' ;
+format STDIN =
+.
+close STDIN;
+write STDIN;
+EXPECT
+Write on closed filehandle at - line 6.
+########
+# pp_sys.c
+use warning 'io' ;
+format STDOUT_TOP =
+abc
+.
+format STDOUT =
+def
+ghi
+.
+$= = 1 ;
+$- =1 ;
+open STDOUT, ">/dev/null" ;
+write ;
+EXPECT
+page overflow at - line 13.
+########
+# pp_sys.c
+use warning 'unopened' ;
+$a = "abc";
+printf $a "fred"
+EXPECT
+Filehandle main::abc never opened at - line 4.
+########
+# pp_sys.c
+use warning 'closed' ;
+close STDIN ;
+printf STDIN "fred"
+EXPECT
+printf on closed filehandle main::STDIN at - line 4.
+########
+# pp_sys.c
+use warning 'io' ;
+printf STDIN "fred"
+EXPECT
+Filehandle main::STDIN opened only for input at - line 3.
+########
+# pp_sys.c
+use warning 'closed' ;
+close STDIN;
+syswrite STDIN, "fred", 1;
+EXPECT
+Syswrite on closed filehandle at - line 4.
+########
+# pp_sys.c
+use warning 'io' ;
+use Config;
+BEGIN {
+ if ( $^O ne 'VMS' and ! $Config{d_socket}) {
+ print <<EOM ;
+SKIPPED
+# send not present
+# bind not present
+# connect not present
+# accept not present
+# shutdown not present
+# setsockopt not present
+# getsockopt not present
+# getsockname not present
+# getpeername not present
+EOM
+ exit ;
+ }
+}
+close STDIN;
+send STDIN, "fred", 1;
+bind STDIN, "fred" ;
+connect STDIN, "fred" ;
+listen STDIN, 2;
+accept STDIN, "fred" ;
+shutdown STDIN, 0;
+setsockopt STDIN, 1,2,3;
+getsockopt STDIN, 1,2;
+getsockname STDIN;
+getpeername STDIN;
+EXPECT
+Send on closed socket at - line 22.
+bind() on closed fd at - line 23.
+connect() on closed fd at - line 24.
+listen() on closed fd at - line 25.
+accept() on closed fd at - line 26.
+shutdown() on closed fd at - line 27.
+[gs]etsockopt() on closed fd at - line 28.
+[gs]etsockopt() on closed fd at - line 29.
+get{sock, peer}name() on closed fd at - line 30.
+get{sock, peer}name() on closed fd at - line 31.
+########
+# pp_sys.c
+use warning 'newline' ;
+stat "abc\ndef";
+EXPECT
+Unsuccessful stat on filename containing newline at - line 3.
+########
+# pp_sys.c
+use warning 'unopened' ;
+close STDIN ;
+-T STDIN ;
+EXPECT
+Test on unopened file <STDIN> at - line 4.
+########
+# pp_sys.c
+use warning 'newline' ;
+-T "abc\ndef" ;
+EXPECT
+Unsuccessful open on filename containing newline at - line 3.
diff --git a/t/pragma/warn/regcomp b/t/pragma/warn/regcomp
new file mode 100644
index 0000000000..52a163a2f5
--- /dev/null
+++ b/t/pragma/warn/regcomp
@@ -0,0 +1,53 @@
+ regcomp.c AOK
+
+ %.*s matches null string many times
+
+ $a = "ABC123" ; $a =~ /(?=a)*/'
+
+ Strange *+?{} on zero-length expression
+
+ /(?=a)?/
+
+ Character class syntax [: :] is reserved for future extensions
+ /[a[:xyz:]b]/
+
+ Character class syntax [. .] is reserved for future extensions
+ Character class syntax [= =] is reserved for future extensions
+
+__END__
+# regcomp.c
+use warning 'unsafe' ;
+my $a = "ABC123" ;
+$a =~ /(?=a)*/ ;
+EXPECT
+(?=a)* matches null string many times at - line 4.
+########
+# regcomp.c
+use warning 'unsafe' ;
+$_ = "" ;
+/(?=a)?/;
+EXPECT
+Strange *+?{} on zero-length expression at - line 4.
+########
+# regcomp.c
+use warning 'unsafe' ;
+$_ = "" ;
+/[a[:xyz:]b]/;
+/[a[.xyz.]b]/;
+/[a[=xyz=]b]/;
+EXPECT
+Character class syntax [: :] is reserved for future extensions at - line 4.
+Character class syntax [. .] is reserved for future extensions at - line 5.
+Character class syntax [= =] is reserved for future extensions at - line 6.
+########
+# regcomp.c
+use warning 'unsafe' ;
+# use utf8 ; # Note this line should be uncommented when utf8 gets fixed.
+$_ = "" ;
+/[a[:xyz:]b]/;
+/[a[.xyz.]b]/;
+/[a[=xyz=]b]/;
+EXPECT
+Character class syntax [: :] is reserved for future extensions at - line 5.
+Character class syntax [. .] is reserved for future extensions at - line 6.
+Character class syntax [= =] is reserved for future extensions at - line 7.
diff --git a/t/pragma/warn/regexec b/t/pragma/warn/regexec
new file mode 100644
index 0000000000..158a7538ae
--- /dev/null
+++ b/t/pragma/warn/regexec
@@ -0,0 +1,57 @@
+ regexec.c
+
+ count exceeded %d
+
+ $_ = 'a' x (2**15+1); /^()(a\1)*$/ ;
+ count exceeded %d
+
+ $_ = 'a' x (2**15+1); /^()(a\1)*?$/ ;
+
+__END__
+# regexec.c
+use warning 'unsafe' ;
+print("SKIPPED\n# win32 can't increase stacksize in shell\n"),exit
+ if $^O eq 'MSWin32';
+$_ = 'a' x (2**15+1);
+/^()(a\1)*$/ ;
+#
+# If this test fails with a segmentation violation or similar,
+# you may have to increase the default stacksize limit in your
+# shell. You may need superuser privileges.
+#
+# Under the sh, ksh, zsh:
+# $ ulimit -s
+# 8192
+# $ ulimit -s 16000
+#
+# Under the csh:
+# % limit stacksize
+# stacksize 8192 kbytes
+# % limit stacksize 16000
+#
+EXPECT
+Complex regular subexpression recursion limit (32766) exceeded at - line 6.
+########
+# regexec.c
+use warning 'unsafe' ;
+print("SKIPPED\n# win32 can't increase stacksize in shell\n"),exit
+ if $^O eq 'MSWin32';
+$_ = 'a' x (2**15+1);
+/^()(a\1)*?$/ ;
+#
+# If this test fails with a segmentation violation or similar,
+# you may have to increase the default stacksize limit in your
+# shell. You may need superuser privileges.
+#
+# Under the sh, ksh, zsh:
+# $ ulimit -s
+# 8192
+# $ ulimit -s 16000
+#
+# Under the csh:
+# % limit stacksize
+# stacksize 8192 kbytes
+# % limit stacksize 16000
+#
+EXPECT
+Complex regular subexpression recursion limit (32766) exceeded at - line 6.
diff --git a/t/pragma/warn/sv b/t/pragma/warn/sv
new file mode 100644
index 0000000000..0f1d83c2e5
--- /dev/null
+++ b/t/pragma/warn/sv
@@ -0,0 +1,203 @@
+ sv.c AOK
+
+ warn(warn_uninit);
+
+ warn(warn_uninit);
+
+ warn(warn_uninit);
+
+ warn(warn_uninit);
+
+ not_a_number(sv);
+
+ not_a_number(sv);
+
+ warn(warn_uninit);
+
+ not_a_number(sv);
+
+ warn(warn_uninit);
+
+ not_a_number(sv);
+
+ not_a_number(sv);
+
+ warn(warn_uninit);
+
+ warn(warn_uninit);
+
+ Subroutine %s redefined
+
+ Invalid conversion in %s:
+
+ Undefined value assigned to typeglob
+
+
+__END__
+# sv.c
+use integer ;
+use warning 'uninitialized' ;
+$x = 1 + $a[0] ; # a
+EXPECT
+Use of uninitialized value at - line 4.
+########
+# sv.c (sv_2iv)
+package fred ;
+sub TIESCALAR { my $x ; bless \$x}
+sub FETCH { return undef }
+sub STORE { return 1 }
+package main ;
+tie $A, 'fred' ;
+use integer ;
+use warning 'uninitialized' ;
+$A *= 2 ;
+EXPECT
+Use of uninitialized value at - line 10.
+########
+# sv.c
+use integer ;
+use warning 'uninitialized' ;
+my $x *= 2 ; #b
+EXPECT
+Use of uninitialized value at - line 4.
+########
+# sv.c (sv_2uv)
+package fred ;
+sub TIESCALAR { my $x ; bless \$x}
+sub FETCH { return undef }
+sub STORE { return 1 }
+package main ;
+tie $A, 'fred' ;
+use warning 'uninitialized' ;
+$B = 0 ;
+$B |= $A ;
+EXPECT
+Use of uninitialized value at - line 10.
+########
+# sv.c
+use warning 'uninitialized' ;
+my $Y = 1 ;
+my $x = 1 | $a[$Y]
+EXPECT
+Use of uninitialized value at - line 4.
+########
+# sv.c
+use warning 'uninitialized' ;
+my $x *= 1 ; # d
+EXPECT
+Use of uninitialized value at - line 3.
+########
+# sv.c
+use warning 'uninitialized' ;
+$x = 1 + $a[0] ; # e
+EXPECT
+Use of uninitialized value at - line 3.
+########
+# sv.c (sv_2nv)
+package fred ;
+sub TIESCALAR { my $x ; bless \$x}
+sub FETCH { return undef }
+sub STORE { return 1 }
+package main ;
+tie $A, 'fred' ;
+use warning 'uninitialized' ;
+$A *= 2 ;
+EXPECT
+Use of uninitialized value at - line 9.
+########
+# sv.c
+use warning 'uninitialized' ;
+$x = $y + 1 ; # f
+EXPECT
+Use of uninitialized value at - line 3.
+########
+# sv.c
+use warning 'uninitialized' ;
+$x = chop undef ; # g
+EXPECT
+Use of uninitialized value at - line 3.
+########
+# sv.c
+use warning 'uninitialized' ;
+$x = chop $y ; # h
+EXPECT
+Use of uninitialized value at - line 3.
+########
+# sv.c (sv_2pv)
+package fred ;
+sub TIESCALAR { my $x ; bless \$x}
+sub FETCH { return undef }
+sub STORE { return 1 }
+package main ;
+tie $A, 'fred' ;
+use warning 'uninitialized' ;
+$B = "" ;
+$B .= $A ;
+EXPECT
+Use of uninitialized value at - line 10.
+########
+# sv.c
+use warning 'numeric' ;
+sub TIESCALAR{bless[]} ;
+sub FETCH {"def"} ;
+tie $a,"main" ;
+my $b = 1 + $a
+EXPECT
+Argument "def" isn't numeric in add at - line 6.
+########
+# sv.c
+use warning 'numeric' ;
+my $x = 1 + "def" ;
+EXPECT
+Argument "def" isn't numeric in add at - line 3.
+########
+# sv.c
+use warning 'numeric' ;
+my $a = "def" ;
+my $x = 1 + $a ;
+EXPECT
+Argument "def" isn't numeric in add at - line 4.
+########
+# sv.c
+use warning 'numeric' ; use integer ;
+my $a = "def" ;
+my $x = 1 + $a ;
+EXPECT
+Argument "def" isn't numeric in i_add at - line 4.
+########
+# sv.c
+use warning 'numeric' ;
+my $x = 1 & "def" ;
+EXPECT
+Argument "def" isn't numeric in bit_and at - line 3.
+########
+# sv.c
+use warning 'redefine' ;
+sub fred {}
+sub joe {}
+*fred = \&joe ;
+EXPECT
+Subroutine fred redefined at - line 5.
+########
+# sv.c
+use warning 'printf' ;
+open F, ">/dev/null" ;
+printf F "%q\n" ;
+my $a = sprintf "%q" ;
+printf F "%" ;
+$a = sprintf "%" ;
+printf F "%\x02" ;
+$a = sprintf "%\x02" ;
+EXPECT
+Invalid conversion in sprintf: "%q" at - line 5.
+Invalid conversion in sprintf: end of string at - line 7.
+Invalid conversion in sprintf: "%\002" at - line 9.
+Invalid conversion in printf: "%q" at - line 4.
+Invalid conversion in printf: end of string at - line 6.
+Invalid conversion in printf: "%\002" at - line 8.
+########
+# sv.c
+use warning 'unsafe' ;
+*a = undef ;
+EXPECT
+Undefined value assigned to typeglob at - line 3.
diff --git a/t/pragma/warn/taint b/t/pragma/warn/taint
new file mode 100644
index 0000000000..40fadd0913
--- /dev/null
+++ b/t/pragma/warn/taint
@@ -0,0 +1,25 @@
+ taint.c TODO
+
+ Insecure %s%s while running setuid
+ Insecure %s%s while running setgid
+ Insecure %s%s while running with -T switch
+
+
+ Insecure directory in %s%s while running setuid
+ Insecure directory in %s%s while running setgid
+ Insecure directory in %s%s while running with -T switch
+
+
+
+__END__
+# taint.c
+use warning 'misc' ;
+
+EXPECT
+
+########
+# taint.c
+use warning 'misc' ;
+
+EXPECT
+
diff --git a/t/pragma/warn/toke b/t/pragma/warn/toke
new file mode 100644
index 0000000000..6cc4a500a4
--- /dev/null
+++ b/t/pragma/warn/toke
@@ -0,0 +1,315 @@
+toke.c AOK
+
+ we seem to have lost a few ambiguous warnings!!
+
+
+ 1 if $a EQ $b ;
+ 1 if $a NE $b ;
+ 1 if $a LT $b ;
+ 1 if $a GT $b ;
+ 1 if $a GE $b ;
+ 1 if $a LE $b ;
+ $a = <<;
+ Use of comma-less variable list is deprecated
+ (called 3 times via depcom)
+
+ \1 better written as $1
+ use warning 'syntax' ;
+ s/(abc)/\1/;
+
+ warn(warn_nosemi)
+ Semicolon seems to be missing
+ $a = 1
+ &time ;
+
+
+ Reversed %c= operator
+ my $a =+ 2 ;
+ $a =- 2 ;
+ $a =* 2 ;
+ $a =% 2 ;
+ $a =& 2 ;
+ $a =. 2 ;
+ $a =^ 2 ;
+ $a =| 2 ;
+ $a =< 2 ;
+ $a =/ 2 ;
+
+ Multidimensional syntax %.*s not supported
+ my $a = $a[1,2] ;
+
+ You need to quote \"%s\""
+ sub fred {} ; $SIG{TERM} = fred;
+
+ Scalar value %.*s better written as $%.*s"
+ @a[3] = 2;
+ @a{3} = 2;
+
+ Can't use \\%c to mean $%c in expression
+ $_ = "ab" ; s/(ab)/\1/e;
+
+ Unquoted string "abc" may clash with future reserved word at - line 3.
+ warn(warn_reserved
+ $a = abc;
+
+ chmod: mode argument is missing initial 0
+ chmod 3;
+
+ Possible attempt to separate words with commas
+ @a = qw(a, b, c) ;
+
+ Possible attempt to put comments in qw() list
+ @a = qw(a b # c) ;
+
+ umask: argument is missing initial 0
+ umask 3;
+
+ %s (...) interpreted as function
+ print ("")
+ printf ("")
+ sort ("")
+
+ Ambiguous use of %c{%s%s} resolved to %c%s%s
+ $a = ${time[2]}
+ $a = ${time{2}}
+
+
+ Ambiguous use of %c{%s} resolved to %c%s
+ $a = ${time}
+ sub fred {} $a = ${fred}
+
+ Misplaced _ in number
+ $a = 1_2;
+ $a = 1_2345_6;
+
+ Bareword \"%s\" refers to nonexistent package
+ $a = FRED:: ;
+
+ Ambiguous call resolved as CORE::%s(), qualify as such or use &
+ sub time {}
+ my $a = time()
+
+ Use of \\x{} without utf8 declaration
+ $_ = " \x{123} " ;
+
+
+ \x%.*s will produce malformed UTF-8 character; use \x{%.*s} for that
+ use utf8 ;
+ $_ = "\xffe"
+
+__END__
+# toke.c
+use warning 'deprecated' ;
+1 if $a EQ $b ;
+1 if $a NE $b ;
+1 if $a GT $b ;
+1 if $a LT $b ;
+1 if $a GE $b ;
+1 if $a LE $b ;
+EXPECT
+Use of EQ is deprecated at - line 3.
+Use of NE is deprecated at - line 4.
+Use of GT is deprecated at - line 5.
+Use of LT is deprecated at - line 6.
+Use of GE is deprecated at - line 7.
+Use of LE is deprecated at - line 8.
+########
+# toke.c
+use warning 'deprecated' ;
+format STDOUT =
+@<<< @||| @>>> @>>>
+$a $b "abc" 'def'
+.
+($a, $b) = (1,2,3);
+write;
+EXPECT
+Use of comma-less variable list is deprecated at - line 5.
+Use of comma-less variable list is deprecated at - line 5.
+Use of comma-less variable list is deprecated at - line 5.
+1 2 abc def
+########
+# toke.c
+use warning 'deprecated' ;
+$a = <<;
+
+EXPECT
+Use of bare << to mean <<"" is deprecated at - line 3.
+########
+# toke.c
+use warning 'syntax' ;
+s/(abc)/\1/;
+EXPECT
+\1 better written as $1 at - line 3.
+########
+# toke.c
+use warning 'semicolon' ;
+$a = 1
+&time ;
+EXPECT
+Semicolon seems to be missing at - line 3.
+########
+# toke.c
+BEGIN {
+ # Scalars leaked: due to syntax errors
+ $ENV{PERL_DESTRUCT_LEVEL} = 0 unless $ENV{PERL_DESTRUCT_LEVEL} > 3;
+}
+use warning 'syntax' ;
+my $a =+ 2 ;
+$a =- 2 ;
+$a =* 2 ;
+$a =% 2 ;
+$a =& 2 ;
+$a =. 2 ;
+$a =^ 2 ;
+$a =| 2 ;
+$a =< 2 ;
+$a =/ 2 ;
+EXPECT
+Reversed += operator at - line 7.
+Reversed -= operator at - line 8.
+Reversed *= operator at - line 9.
+Reversed %= operator at - line 10.
+Reversed &= operator at - line 11.
+Reversed .= operator at - line 12.
+syntax error at - line 12, near "=."
+Reversed ^= operator at - line 13.
+syntax error at - line 13, near "=^"
+Reversed |= operator at - line 14.
+syntax error at - line 14, near "=|"
+Reversed <= operator at - line 15.
+Unterminated <> operator at - line 15.
+########
+# toke.c
+use warning 'syntax' ;
+my $a = $a[1,2] ;
+EXPECT
+Multidimensional syntax $a[1,2] not supported at - line 3.
+########
+# toke.c
+use warning 'syntax' ;
+sub fred {} ; $SIG{TERM} = fred;
+EXPECT
+You need to quote "fred" at - line 3.
+########
+# toke.c
+use warning 'syntax' ;
+@a[3] = 2;
+@a{3} = 2;
+EXPECT
+Scalar value @a[3] better written as $a[3] at - line 3.
+Scalar value @a{3} better written as $a{3} at - line 4.
+########
+# toke.c
+use warning 'syntax' ;
+$_ = "ab" ;
+s/(ab)/\1/e;
+EXPECT
+Can't use \1 to mean $1 in expression at - line 4.
+########
+# toke.c
+use warning 'reserved' ;
+$a = abc;
+EXPECT
+Unquoted string "abc" may clash with future reserved word at - line 3.
+########
+# toke.c
+use warning 'octal' ;
+chmod 3;
+EXPECT
+chmod: mode argument is missing initial 0 at - line 3, at end of line
+########
+# toke.c
+use warning 'syntax' ;
+@a = qw(a, b, c) ;
+EXPECT
+Possible attempt to separate words with commas at - line 3.
+########
+# toke.c
+use warning 'syntax' ;
+@a = qw(a b #) ;
+EXPECT
+Possible attempt to put comments in qw() list at - line 3.
+########
+# toke.c
+use warning 'octal' ;
+umask 3;
+EXPECT
+umask: argument is missing initial 0 at - line 3, at end of line
+########
+# toke.c
+use warning 'syntax' ;
+print ("")
+EXPECT
+print (...) interpreted as function at - line 3.
+########
+# toke.c
+use warning 'syntax' ;
+printf ("")
+EXPECT
+printf (...) interpreted as function at - line 3.
+########
+# toke.c
+use warning 'syntax' ;
+sort ("")
+EXPECT
+sort (...) interpreted as function at - line 3.
+########
+# toke.c
+use warning 'ambiguous' ;
+$a = ${time[2]};
+EXPECT
+Ambiguous use of ${time[...]} resolved to $time[...] at - line 3.
+########
+# toke.c
+use warning 'ambiguous' ;
+$a = ${time{2}};
+EXPECT
+Ambiguous use of ${time{...}} resolved to $time{...} at - line 3.
+########
+# toke.c
+use warning 'ambiguous' ;
+$a = ${time} ;
+EXPECT
+Ambiguous use of ${time} resolved to $time at - line 3.
+########
+# toke.c
+use warning 'ambiguous' ;
+sub fred {}
+$a = ${fred} ;
+EXPECT
+Ambiguous use of ${fred} resolved to $fred at - line 4.
+########
+# toke.c
+use warning 'syntax' ;
+$a = 1_2;
+$a = 1_2345_6;
+EXPECT
+Misplaced _ in number at - line 3.
+Misplaced _ in number at - line 4.
+Misplaced _ in number at - line 4.
+########
+# toke.c
+use warning 'unsafe' ;
+$a = FRED:: ;
+EXPECT
+Bareword "FRED::" refers to nonexistent package at - line 3.
+########
+# toke.c
+use warning 'ambiguous' ;
+sub time {}
+my $a = time()
+EXPECT
+Ambiguous call resolved as CORE::time(), qualify as such or use & at - line 4.
+########
+# toke.c
+use warning 'utf8' ;
+$_ = " \x{123} " ;
+EXPECT
+Use of \x{} without utf8 declaration at - line 3.
+########
+# toke.c
+use warning 'utf8' ;
+use utf8 ;
+$_ = " \xffe " ;
+EXPECT
+\xff will produce malformed UTF-8 character; use \x{ff} for that at - line 4.
diff --git a/t/pragma/warn/universal b/t/pragma/warn/universal
new file mode 100644
index 0000000000..e2814e11c4
--- /dev/null
+++ b/t/pragma/warn/universal
@@ -0,0 +1,11 @@
+ universal.c
+
+ Can't locate package %s for @%s::ISA
+
+
+__END__
+# universal.c
+use warning 'misc' ;
+
+EXPECT
+
diff --git a/t/pragma/warn/util b/t/pragma/warn/util
new file mode 100644
index 0000000000..649a2929ce
--- /dev/null
+++ b/t/pragma/warn/util
@@ -0,0 +1,21 @@
+ util.c AOK
+
+ Illegal octal digit ignored
+ my $a = oct "029" ;
+
+ Illegal hex digit ignored
+ my $a = hex "0xv9" ;
+
+
+__END__
+# util.c
+use warning 'octal' ;
+my $a = oct "029" ;
+EXPECT
+Illegal octal digit ignored at - line 3.
+########
+# util.c
+use warning 'unsafe' ;
+*a = hex "0xv9" ;
+EXPECT
+Illegal hex digit ignored at - line 3.