diff options
Diffstat (limited to 'gnu/usr.bin/perl/t/lib')
91 files changed, 9872 insertions, 2 deletions
diff --git a/gnu/usr.bin/perl/t/lib/1_compile.t b/gnu/usr.bin/perl/t/lib/1_compile.t new file mode 100644 index 00000000000..45631dd5b8d --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/1_compile.t @@ -0,0 +1,81 @@ +#!./perl + +# Modules should have their own tests. For historical reasons, some +# do not. This does basic compile tests on modules that have no tests +# of their own. + +BEGIN { + chdir 't'; + @INC = '../lib'; +} + +use strict; +use warnings; +use File::Spec::Functions; + +# Okay, this is the list. + +my @Core_Modules = grep /\S/, <DATA>; +chomp @Core_Modules; + +if (eval { require Socket }) { + push @Core_Modules, qw(Net::Domain); + # Two Net:: modules need the Convert::EBCDIC if in EBDCIC. + if (ord("A") != 193 || eval { require Convert::EBCDIC }) { + push @Core_Modules, qw(Net::Cmd Net::POP3); + } +} + +@Core_Modules = sort @Core_Modules; + +print "1..".(1+@Core_Modules)."\n"; + +my $message + = "ok 1 - All modules should have tests # TODO Make Schwern Poorer\n"; +if (@Core_Modules) { + print "not $message"; +} else { + print $message; +} + +my $test_num = 2; + +foreach my $module (@Core_Modules) { + my $todo = ''; + $todo = "# TODO $module needs porting on $^O" if $module eq 'ByteLoader' && $^O eq 'VMS'; + print "# $module compile failed\nnot " unless compile_module($module); + print "ok $test_num $todo\n"; + $test_num++; +} + +# We do this as a separate process else we'll blow the hell +# out of our namespace. +sub compile_module { + my ($module) = $_[0]; + + my $compmod = catfile(curdir(), 'lib', 'compmod.pl'); + my $lib = '-I' . catdir(updir(), 'lib'); + + my $out = scalar `$^X $lib $compmod $module`; + print "# $out"; + return $out =~ /^ok/; +} + +# These modules have no tests of their own. +# Keep up to date with +# http://www.pobox.com/~schwern/cgi-bin/perl-qa-wiki.cgi?UntestedModules +# and vice-versa. The list should only shrink. +__DATA__ +B::C +B::CC +B::Stackobj +ByteLoader +CPAN +CPAN::FirstTime +DynaLoader +ExtUtils::MM_NW5 +ExtUtils::Install +ExtUtils::Liblist +ExtUtils::Mksymlists +Pod::Plainer +Test::Harness::Iterator diff --git a/gnu/usr.bin/perl/t/lib/Filter/Simple/ExportTest.pm b/gnu/usr.bin/perl/t/lib/Filter/Simple/ExportTest.pm new file mode 100644 index 00000000000..d6da62921b7 --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/Filter/Simple/ExportTest.pm @@ -0,0 +1,12 @@ +package ExportTest; + +use Filter::Simple; +use base Exporter; + +@EXPORT_OK = qw(ok); + +FILTER { s/not// }; + +sub ok { print "ok @_\n" } + +1; diff --git a/gnu/usr.bin/perl/t/lib/Filter/Simple/FilterOnlyTest.pm b/gnu/usr.bin/perl/t/lib/Filter/Simple/FilterOnlyTest.pm new file mode 100644 index 00000000000..856e79de6ac --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/Filter/Simple/FilterOnlyTest.pm @@ -0,0 +1,11 @@ +package FilterOnlyTest; + +use Filter::Simple; + +FILTER_ONLY + string => sub { + my $class = shift; + while (my($pat, $str) = splice @_, 0, 2) { + s/$pat/$str/g; + } + }; diff --git a/gnu/usr.bin/perl/t/lib/Filter/Simple/FilterTest.pm b/gnu/usr.bin/perl/t/lib/Filter/Simple/FilterTest.pm new file mode 100644 index 00000000000..c49e280d2c5 --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/Filter/Simple/FilterTest.pm @@ -0,0 +1,12 @@ +package FilterTest; + +use Filter::Simple; + +FILTER { + my $class = shift; + while (my($pat, $str) = splice @_, 0, 2) { + s/$pat/$str/g; + } +}; + +1; diff --git a/gnu/usr.bin/perl/t/lib/Filter/Simple/ImportTest.pm b/gnu/usr.bin/perl/t/lib/Filter/Simple/ImportTest.pm new file mode 100644 index 00000000000..6646a36a685 --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/Filter/Simple/ImportTest.pm @@ -0,0 +1,19 @@ +package ImportTest; + +use base 'Exporter'; +@EXPORT = qw(say); + +sub say { print @_ } + +use Filter::Simple; + +sub import { + my $class = shift; + print "ok $_\n" foreach @_; + __PACKAGE__->export_to_level(1,$class); +} + +FILTER { s/not // }; + + +1; diff --git a/gnu/usr.bin/perl/t/lib/MakeMaker/Test/Utils.pm b/gnu/usr.bin/perl/t/lib/MakeMaker/Test/Utils.pm new file mode 100644 index 00000000000..9260faf3433 --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/MakeMaker/Test/Utils.pm @@ -0,0 +1,241 @@ +package MakeMaker::Test::Utils; + +use File::Spec; +use strict; +use Config; + +use vars qw($VERSION @ISA @EXPORT); + +require Exporter; +@ISA = qw(Exporter); + +$VERSION = 0.02; + +@EXPORT = qw(which_perl perl_lib makefile_name makefile_backup + make make_run make_macro calibrate_mtime + ); + +my $Is_VMS = $^O eq 'VMS'; +my $Is_MacOS = $^O eq 'MacOS'; + + +=head1 NAME + +MakeMaker::Test::Utils - Utility routines for testing MakeMaker + +=head1 SYNOPSIS + + use MakeMaker::Test::Utils; + + my $perl = which_perl; + perl_lib; + + my $makefile = makefile_name; + my $makefile_back = makefile_backup; + + my $make = make; + my $make_run = make_run; + make_macro($make, $targ, %macros); + + my $mtime = calibrate_mtime; + +=head1 DESCRIPTION + +A consolidation of little utility functions used through out the +MakeMaker test suite. + +=head2 Functions + +The following are exported by default. + +=over 4 + +=item B<which_perl> + + my $perl = which_perl; + +Returns a path to perl which is safe to use in a command line, no +matter where you chdir to. + +=cut + +sub which_perl { + my $perl = $^X; + $perl ||= 'perl'; + + # VMS should have 'perl' aliased properly + return $perl if $Is_VMS; + + $perl .= $Config{exe_ext} unless $perl =~ m/$Config{exe_ext}$/i; + + my $perlpath = File::Spec->rel2abs( $perl ); + unless( $Is_MacOS || -x $perlpath ) { + # $^X was probably 'perl' + + # When building in the core, *don't* go off and find + # another perl + die "Can't find a perl to use (\$^X=$^X), (\$perlpath=$perlpath)" + if $ENV{PERL_CORE}; + + foreach my $path (File::Spec->path) { + $perlpath = File::Spec->catfile($path, $perl); + last if -x $perlpath; + } + } + + return $perlpath; +} + +=item B<perl_lib> + + perl_lib; + +Sets up environment variables so perl can find its libraries. + +=cut + +my $old5lib = $ENV{PERL5LIB}; +my $had5lib = exists $ENV{PERL5LIB}; +sub perl_lib { + # perl-src/t/ + my $lib = $ENV{PERL_CORE} ? qq{../lib} + # ExtUtils-MakeMaker/t/ + : qq{../blib/lib}; + $lib = File::Spec->rel2abs($lib); + my @libs = ($lib); + push @libs, $ENV{PERL5LIB} if exists $ENV{PERL5LIB}; + $ENV{PERL5LIB} = join($Config{path_sep}, @libs); + unshift @INC, $lib; +} + +END { + if( $had5lib ) { + $ENV{PERL5LIB} = $old5lib; + } + else { + delete $ENV{PERL5LIB}; + } +} + + +=item B<makefile_name> + + my $makefile = makefile_name; + +MakeMaker doesn't always generate 'Makefile'. It returns what it +should generate. + +=cut + +sub makefile_name { + return $Is_VMS ? 'Descrip.MMS' : 'Makefile'; +} + +=item B<makefile_backup> + + my $makefile_old = makefile_backup; + +Returns the name MakeMaker will use for a backup of the current +Makefile. + +=cut + +sub makefile_backup { + my $makefile = makefile_name; + return $Is_VMS ? $makefile : "$makefile.old"; +} + +=item B<make> + + my $make = make; + +Returns a good guess at the make to run. + +=cut + +sub make { + my $make = $Config{make}; + $make = $ENV{MAKE} if exists $ENV{MAKE}; + + return $make; +} + +=item B<make_run> + + my $make_run = make_run; + +Returns the make to run as with make() plus any necessary switches. + +=cut + +sub make_run { + my $make = make; + $make .= ' -nologo' if $make eq 'nmake'; + + return $make; +} + +=item B<make_macro> + + my $make_cmd = make_macro($make, $target, %macros); + +Returns the command necessary to run $make on the given $target using +the given %macros. + + my $make_test_verbose = make_macro(make_run(), 'test', + TEST_VERBOSE => 1); + +This is important because VMS's make utilities have a completely +different calling convention than Unix or Windows. + +%macros is actually a list of tuples, so the order will be preserved. + +=cut + +sub make_macro { + my($make, $target) = (shift, shift); + + my $is_mms = $make =~ /^MM(K|S)/i; + + my $cmd = $make; + my $macros = ''; + while( my($key,$val) = splice(@_, 0, 2) ) { + if( $is_mms ) { + $macros .= qq{/macro="$key=$val"}; + } + else { + $macros .= qq{ $key=$val}; + } + } + + return $is_mms ? "$make$macros $target" : "$make $target $macros"; +} + +=item B<calibrate_mtime> + + my $mtime = calibrate_mtime; + +When building on NFS, file modification times can often lose touch +with reality. This returns the mtime of a file which has just been +touched. + +=cut + +sub calibrate_mtime { + open(FILE, ">calibrate_mtime.tmp") || die $!; + print FILE "foo"; + close FILE; + my($mtime) = (stat('calibrate_mtime.tmp'))[9]; + unlink 'calibrate_mtime.tmp'; + return $mtime; +} + +=back + +=head1 AUTHOR + +Michael G Schwern <schwern@pobox.com> + +=cut + +1; diff --git a/gnu/usr.bin/perl/t/lib/Math/BigFloat/Subclass.pm b/gnu/usr.bin/perl/t/lib/Math/BigFloat/Subclass.pm new file mode 100644 index 00000000000..82ad7e6c833 --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/Math/BigFloat/Subclass.pm @@ -0,0 +1,44 @@ +#!/usr/bin/perl -w + +package Math::BigFloat::Subclass; + +require 5.005_02; +use strict; + +use Exporter; +use Math::BigFloat(1.27); +use vars qw($VERSION @ISA $PACKAGE + $accuracy $precision $round_mode $div_scale); + +@ISA = qw(Exporter Math::BigFloat); + +$VERSION = 0.03; + +use overload; # inherit overload from BigInt + +# Globals +$accuracy = $precision = undef; +$round_mode = 'even'; +$div_scale = 40; + +sub new +{ + my $proto = shift; + my $class = ref($proto) || $proto; + + my $value = shift; + my $a = $accuracy; $a = $_[0] if defined $_[0]; + my $p = $precision; $p = $_[1] if defined $_[1]; + # Store the floating point value + my $self = Math::BigFloat->new($value,$a,$p,$round_mode); + bless $self, $class; + $self->{'_custom'} = 1; # make sure this never goes away + return $self; +} + +BEGIN + { + *objectify = \&Math::BigInt::objectify; + } + +1; diff --git a/gnu/usr.bin/perl/t/lib/Math/BigInt/BareCalc.pm b/gnu/usr.bin/perl/t/lib/Math/BigInt/BareCalc.pm new file mode 100644 index 00000000000..797957f7481 --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/Math/BigInt/BareCalc.pm @@ -0,0 +1,36 @@ +package Math::BigInt::BareCalc; + +use 5.005; +use strict; +# use warnings; # dont use warnings for older Perls + +require Exporter; +use vars qw/@ISA $VERSION/; +@ISA = qw(Exporter); + +$VERSION = '0.02'; + +# Package to to test Bigint's simulation of Calc + +# uses Calc, but only features the strictly necc. methods. + +use Math::BigInt::Calc '0.29'; + +BEGIN + { + no strict 'refs'; + foreach (qw/ base_len new zero one two copy str num add sub mul div inc dec + acmp len digit zeros + is_zero is_one is_odd is_even is_one check + to_small to_large + /) + { + my $name = "Math::BigInt::Calc::_$_"; + *{"Math::BigInt::BareCalc::_$_"} = \&$name; + } + } + +# catch and throw away +sub import { } + +1; diff --git a/gnu/usr.bin/perl/t/lib/Math/BigInt/Subclass.pm b/gnu/usr.bin/perl/t/lib/Math/BigInt/Subclass.pm new file mode 100644 index 00000000000..688ad237698 --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/Math/BigInt/Subclass.pm @@ -0,0 +1,81 @@ +#!/usr/bin/perl -w + +package Math::BigInt::Subclass; + +require 5.005_02; +use strict; + +use Exporter; +use Math::BigInt(1.56); +use vars qw($VERSION @ISA $PACKAGE @EXPORT_OK + $accuracy $precision $round_mode $div_scale); + +@ISA = qw(Exporter Math::BigInt); +@EXPORT_OK = qw(bgcd objectify); + +$VERSION = 0.03; + +use overload; # inherit overload from BigInt + +# Globals +$accuracy = $precision = undef; +$round_mode = 'even'; +$div_scale = 40; + +sub new +{ + my $proto = shift; + my $class = ref($proto) || $proto; + + my $value = shift; + my $a = $accuracy; $a = $_[0] if defined $_[0]; + my $p = $precision; $p = $_[1] if defined $_[1]; + my $self = Math::BigInt->new($value,$a,$p,$round_mode); + bless $self,$class; + $self->{'_custom'} = 1; # make sure this never goes away + return $self; +} + +sub bgcd + { + Math::BigInt::bgcd(@_); + } + +sub blcm + { + Math::BigInt::blcm(@_); + } + +BEGIN + { + *objectify = \&Math::BigInt::objectify; + + # these are called by AUTOLOAD from BigFloat, so we need at least these. + # We cheat, of course.. + *bneg = \&Math::BigInt::bneg; + *babs = \&Math::BigInt::babs; + *bnan = \&Math::BigInt::bnan; + *binf = \&Math::BigInt::binf; + *bzero = \&Math::BigInt::bzero; + *bone = \&Math::BigInt::bone; + } + +sub import + { + my $self = shift; + + my @a; my $t = 0; + foreach (@_) + { + $t = 0, next if $t == 1; + if ($_ eq 'lib') + { + $t = 1; next; + } + push @a,$_; + } + $self->SUPER::import(@a); # need it for subclasses + $self->export_to_level(1,$self,@a); # need this ? + } + +1; diff --git a/gnu/usr.bin/perl/t/lib/Math/BigRat/Test.pm b/gnu/usr.bin/perl/t/lib/Math/BigRat/Test.pm new file mode 100644 index 00000000000..80be068a27a --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/Math/BigRat/Test.pm @@ -0,0 +1,81 @@ +#!/usr/bin/perl -w + +package Math::BigRat::Test; + +require 5.005_02; +use strict; + +use Exporter; +use Math::BigRat; +use Math::BigFloat; +use vars qw($VERSION @ISA $PACKAGE + $accuracy $precision $round_mode $div_scale); + +@ISA = qw(Exporter Math::BigRat); +$VERSION = 0.03; + +use overload; # inherit overload from BigRat + +# Globals +$accuracy = $precision = undef; +$round_mode = 'even'; +$div_scale = 40; + +my $class = 'Math::BigRat::Test'; + +#ub new +#{ +# my $proto = shift; +# my $class = ref($proto) || $proto; +# +# my $value = shift; +# my $a = $accuracy; $a = $_[0] if defined $_[0]; +# my $p = $precision; $p = $_[1] if defined $_[1]; +# # Store the floating point value +# my $self = Math::BigFloat->new($value,$a,$p,$round_mode); +# bless $self, $class; +# $self->{'_custom'} = 1; # make sure this never goes away +# return $self; +#} + +sub bstr + { + # calculate a BigFloat compatible string output + my ($x) = @_; + + $x = $class->new($x) unless ref $x; + + if ($x->{sign} !~ /^[+-]$/) # inf, NaN etc + { + my $s = $x->{sign}; $s =~ s/^\+//; # +inf => inf + return $s; + } + + my $s = ''; $s = $x->{sign} if $x->{sign} ne '+'; # +3 vs 3 + + return $s.$x->{_n} if $x->{_d}->is_one(); + my $output = Math::BigFloat->new($x->{_n})->bdiv($x->{_d}); + return $s.$output->bstr(); + } + +sub bsstr + { + # calculate a BigFloat compatible string output + my ($x) = @_; + + $x = $class->new($x) unless ref $x; + + if ($x->{sign} !~ /^[+-]$/) # inf, NaN etc + { + my $s = $x->{sign}; $s =~ s/^\+//; # +inf => inf + return $s; + } + + my $s = ''; $s = $x->{sign} if $x->{sign} ne '+'; # +3 vs 3 + + return $s.$x->{_n}->bsstr() if $x->{_d}->is_one(); + my $output = Math::BigFloat->new($x->{_n})->bdiv($x->{_d}); + return $s.$output->bsstr(); + } + +1; diff --git a/gnu/usr.bin/perl/t/lib/Test/Simple/Catch.pm b/gnu/usr.bin/perl/t/lib/Test/Simple/Catch.pm new file mode 100644 index 00000000000..e1ccd7ce454 --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/Test/Simple/Catch.pm @@ -0,0 +1,32 @@ +# For testing Test::Simple; +package Test::Simple::Catch; + +use Symbol; +my($out_fh, $err_fh) = (gensym, gensym); +my $out = tie *$out_fh, __PACKAGE__; +my $err = tie *$err_fh, __PACKAGE__; + +use Test::Builder; +my $t = Test::Builder->new; +$t->output($out_fh); +$t->failure_output($err_fh); +$t->todo_output($err_fh); + +sub caught { return($out, $err) } + +sub PRINT { + my $self = shift; + $$self .= join '', @_; +} + +sub TIEHANDLE { + my $class = shift; + my $self = ''; + return bless \$self, $class; +} +sub READ {} +sub READLINE {} +sub GETC {} +sub FILENO {} + +1; diff --git a/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/death.plx b/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/death.plx new file mode 100644 index 00000000000..ef4ba8c1880 --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/death.plx @@ -0,0 +1,13 @@ +require Test::Simple; + +push @INC, 't/lib'; +require Test::Simple::Catch; +my($out, $err) = Test::Simple::Catch::caught(); + +Test::Simple->import(tests => 5); +close STDERR; + +ok(1); +ok(1); +ok(1); +die "Knife?"; diff --git a/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/death_in_eval.plx b/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/death_in_eval.plx new file mode 100644 index 00000000000..269bffa8025 --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/death_in_eval.plx @@ -0,0 +1,22 @@ +require Test::Simple; +use Carp; + +push @INC, 't/lib'; +require Test::Simple::Catch; +my($out, $err) = Test::Simple::Catch::caught(); + +Test::Simple->import(tests => 5); + +ok(1); +ok(1); +ok(1); +eval { + die "Foo"; +}; +ok(1); +eval "die 'Bar'"; +ok(1); + +eval { + croak "Moo"; +}; diff --git a/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/extras.plx b/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/extras.plx new file mode 100644 index 00000000000..c9c89520aa3 --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/extras.plx @@ -0,0 +1,16 @@ +require Test::Simple; + +push @INC, 't/lib'; +require Test::Simple::Catch; +my($out, $err) = Test::Simple::Catch::caught(); + +Test::Simple->import(tests => 5); + + +ok(1); +ok(1); +ok(1); +ok(1); +ok(0); +ok(1); +ok(0); diff --git a/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/five_fail.plx b/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/five_fail.plx new file mode 100644 index 00000000000..c058e1f8f01 --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/five_fail.plx @@ -0,0 +1,13 @@ +require Test::Simple; + +use lib 't/lib'; +require Test::Simple::Catch; +my($out, $err) = Test::Simple::Catch::caught(); + +Test::Simple->import(tests => 5); + +ok(0); +ok(0); +ok(''); +ok(0); +ok(0); diff --git a/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/last_minute_death.plx b/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/last_minute_death.plx new file mode 100644 index 00000000000..ef86a63c51e --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/last_minute_death.plx @@ -0,0 +1,16 @@ +require Test::Simple; + +push @INC, 't/lib'; +require Test::Simple::Catch; +my($out, $err) = Test::Simple::Catch::caught(); + +Test::Simple->import(tests => 5); +close STDERR; + +ok(1); +ok(1); +ok(1); +ok(1); +ok(1); + +die "Almost there..."; diff --git a/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/one_fail.plx b/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/one_fail.plx new file mode 100644 index 00000000000..99c720250d2 --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/one_fail.plx @@ -0,0 +1,14 @@ +require Test::Simple; + +push @INC, 't/lib'; +require Test::Simple::Catch; +my($out, $err) = Test::Simple::Catch::caught(); + +Test::Simple->import(tests => 5); + + +ok(1); +ok(2); +ok(0); +ok(1); +ok(2); diff --git a/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/require.plx b/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/require.plx new file mode 100644 index 00000000000..1a06690d9dc --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/require.plx @@ -0,0 +1 @@ +require Test::Simple; diff --git a/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/success.plx b/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/success.plx new file mode 100644 index 00000000000..585d6c3d790 --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/success.plx @@ -0,0 +1,13 @@ +require Test::Simple; + +push @INC, 't/lib'; +require Test::Simple::Catch; +my($out, $err) = Test::Simple::Catch::caught(); + +Test::Simple->import(tests => 5); + +ok(1); +ok(5, 'yep'); +ok(3, 'beer'); +ok("wibble", "wibble"); +ok(1); diff --git a/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/too_few.plx b/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/too_few.plx new file mode 100644 index 00000000000..95af8e903b6 --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/too_few.plx @@ -0,0 +1,11 @@ +require Test::Simple; + +push @INC, 't/lib'; +require Test::Simple::Catch; +my($out, $err) = Test::Simple::Catch::caught(); + +Test::Simple->import(tests => 5); + + +ok(1); +ok(0); diff --git a/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/two_fail.plx b/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/two_fail.plx new file mode 100644 index 00000000000..e3d92296af9 --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/Test/Simple/sample_tests/two_fail.plx @@ -0,0 +1,14 @@ +require Test::Simple; + +push @INC, 't/lib'; +require Test::Simple::Catch; +my($out, $err) = Test::Simple::Catch::caught(); + +Test::Simple->import(tests => 5); + + +ok(0); +ok(1); +ok(1); +ok(0); +ok(1); diff --git a/gnu/usr.bin/perl/t/lib/TieOut.pm b/gnu/usr.bin/perl/t/lib/TieOut.pm new file mode 100644 index 00000000000..072e8fdef6a --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/TieOut.pm @@ -0,0 +1,23 @@ +package TieOut; + +sub TIEHANDLE { + bless( \(my $scalar), $_[0]); +} + +sub PRINT { + my $self = shift; + $$self .= join('', @_); +} + +sub PRINTF { + my $self = shift; + my $fmt = shift; + $$self .= sprintf $fmt, @_; +} + +sub read { + my $self = shift; + return substr($$self, 0, length($$self), ''); +} + +1; diff --git a/gnu/usr.bin/perl/t/lib/commonsense.t b/gnu/usr.bin/perl/t/lib/commonsense.t new file mode 100644 index 00000000000..6e313073d29 --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/commonsense.t @@ -0,0 +1,25 @@ +#!./perl + +chdir 't' if -d 't'; +@INC = '../lib'; +require Config; import Config; +if (($Config{'extensions'} !~ /\b(DB|[A-Z]DBM)_File\b/) ){ + print "Bail out! Perl configured without DB_File or [A-Z]DBM_File\n"; + exit 0; +} +if (($Config{'extensions'} !~ /\bFcntl\b/) ){ + print "Bail out! Perl configured without Fcntl module\n"; + exit 0; +} +if (($Config{'extensions'} !~ /\bIO\b/) ){ + print "Bail out! Perl configured without IO module\n"; + exit 0; +} +# hey, DOS users do not need this kind of common sense ;-) +if ($^O ne 'dos' && ($Config{'extensions'} !~ /\bFile\/Glob\b/) ){ + print "Bail out! Perl configured without File::Glob module\n"; + exit 0; +} + +print "1..1\nok 1\n"; + diff --git a/gnu/usr.bin/perl/t/lib/compmod.pl b/gnu/usr.bin/perl/t/lib/compmod.pl new file mode 100644 index 00000000000..fa032f1acf1 --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/compmod.pl @@ -0,0 +1,19 @@ +#!./perl + +BEGIN { + chdir 't'; + @INC = '../lib'; +} + +my $module = shift; + +# 'require open' confuses Perl, so we use instead. +eval "use $module ();"; +if( $@ ) { + print "not "; + $@ =~ s/\n/\n# /g; + warn "# require failed with '$@'\n"; +} +print "ok - $module\n"; + + diff --git a/gnu/usr.bin/perl/t/lib/filter-util.pl b/gnu/usr.bin/perl/t/lib/filter-util.pl new file mode 100644 index 00000000000..1bc3bfbd930 --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/filter-util.pl @@ -0,0 +1,56 @@ + +use strict ; +use warnings; + +use vars qw( $Perl $Inc); + +sub readFile +{ + my ($filename) = @_ ; + my ($string) = '' ; + + open (F, "<$filename") + or die "Cannot open $filename: $!\n" ; + while (<F>) + { $string .= $_ } + close F ; + $string ; +} + +sub writeFile +{ + my($filename, @strings) = @_ ; + open (F, ">$filename") + or die "Cannot open $filename: $!\n" ; + binmode(F) if $filename =~ /bin$/i; + foreach (@strings) + { print F } + close F or die "Could not close: $!" ; +} + +sub ok +{ + my($number, $result, $note) = @_ ; + + $note = "" if ! defined $note ; + if ($note) { + $note = "# $note" if $note !~ /^\s*#/ ; + $note =~ s/^\s*/ / ; + } + + print "not " if !$result ; + print "ok ${number}${note}\n"; +} + +$Inc = '' ; +foreach (@INC) + { $Inc .= "\"-I$_\" " } +$Inc = "-I::lib" if $^O eq 'MacOS'; + +$Perl = '' ; +$Perl = ($ENV{'FULLPERL'} or $^X or 'perl') ; + +$Perl = "$Perl -MMac::err=unix" if $^O eq 'MacOS'; +$Perl = "$Perl -w" ; + +1; diff --git a/gnu/usr.bin/perl/t/lib/h2ph.h b/gnu/usr.bin/perl/t/lib/h2ph.h index cddf0a7d947..c60e8f008d0 100644 --- a/gnu/usr.bin/perl/t/lib/h2ph.h +++ b/gnu/usr.bin/perl/t/lib/h2ph.h @@ -38,7 +38,7 @@ #if !(defined __SOMETHING_MORE_IMPORTANT) # warn Be careful... #elif !(defined __SOMETHING_REALLY_REALLY_IMPORTANT) -# error Nup, can't go on /* ' /* stupid font-lock-mode */ +# error "Nup, can't go on" /* ' /* stupid font-lock-mode */ #else /* defined __SOMETHING_MORE_IMPORTANT && defined __SOMETHING_REALLY_REALLY_IMPORTANT */ # define EVERYTHING_IS_OK #endif @@ -82,4 +82,43 @@ typedef struct a_struct { typedef enum _days_of_week { sun, mon, tue, wed, thu, fri, sat, Sun=0, Mon, Tue, Wed, Thu, Fri, Sat } days_of_week; +/* + * Some moderate flexing of tri-graph pre substitution. + */ +??=ifndef _SOMETHING_TRIGRAPHIC +??=define _SOMETHING_TRIGRAPHIC +??= define SOMETHING_ELSE_TRIGRAPHIC_0 "??!" /* | ??!| || */ + ??=define SOMETHING_ELSE_TRIGRAPHIC_1 "??'" /* | ??'| ^| */ +??= define SOMETHING_ELSE_TRIGRAPHIC_2 "??(" /* | ??(| [| */ + ??= define SOMETHING_ELSE_TRIGRAPHIC_3 "??)" /* | ??)| ]| */ +??=define SOMETHING_ELSE_TRIGRAPHIC_4 "??-0" /* | ??-| ~| */ + ??= define SOMETHING_ELSE_TRIGRAPHIC_5 "??/ " /* | ??/| \| */ +??= define SOMETHING_ELSE_TRIGRAPHIC_6 "??<" /* | ??<| {| */ +??=define SOMETHING_ELSE_TRIGRAPHIC_7 "??=" /* | ??=| #| */ +??= define SOMETHING_ELSE_TRIGRAPHIC_8 "??>" /* | ??>| }| */ + ??=endif + +// test C++-style comment + +#if 1 +typdef struct empty_struct { +} // trailing C++-style comment should not force continuation +#endif + +/* comments (that look like string) inside enums... */ + +enum { + /* foo; + can't + */ + }; + +enum flimflam { + flim, + /* foo; + can't + */ + flam + } flamflim; + #endif /* _H2PH_H_ */ diff --git a/gnu/usr.bin/perl/t/lib/h2ph.pht b/gnu/usr.bin/perl/t/lib/h2ph.pht index e5b293243ec..a52c1605f07 100644 --- a/gnu/usr.bin/perl/t/lib/h2ph.pht +++ b/gnu/usr.bin/perl/t/lib/h2ph.pht @@ -29,7 +29,7 @@ unless(defined(&_H2PH_H_)) { if(!(defined (defined(&__SOMETHING_MORE_IMPORTANT) ? &__SOMETHING_MORE_IMPORTANT : 0))) { } elsif(!(defined (defined(&__SOMETHING_REALLY_REALLY_IMPORTANT) ? &__SOMETHING_REALLY_REALLY_IMPORTANT : 0))) { - die("Nup\,\ can\'t\ go\ on\ "); + die("Nup, can't go on"); } else { eval 'sub EVERYTHING_IS_OK () {1;}' unless defined(&EVERYTHING_IS_OK); } @@ -67,5 +67,21 @@ unless(defined(&_H2PH_H_)) { eval("sub Thu () { 4; }") unless defined(&Thu); eval("sub Fri () { 5; }") unless defined(&Fri); eval("sub Sat () { 6; }") unless defined(&Sat); + unless(defined(&_SOMETHING_TRIGRAPHIC)) { + eval 'sub _SOMETHING_TRIGRAPHIC () {1;}' unless defined(&_SOMETHING_TRIGRAPHIC); + eval 'sub SOMETHING_ELSE_TRIGRAPHIC_0 () {"|";}' unless defined(&SOMETHING_ELSE_TRIGRAPHIC_0); + eval 'sub SOMETHING_ELSE_TRIGRAPHIC_1 () {"^";}' unless defined(&SOMETHING_ELSE_TRIGRAPHIC_1); + eval 'sub SOMETHING_ELSE_TRIGRAPHIC_2 () {"[";}' unless defined(&SOMETHING_ELSE_TRIGRAPHIC_2); + eval 'sub SOMETHING_ELSE_TRIGRAPHIC_3 () {"]";}' unless defined(&SOMETHING_ELSE_TRIGRAPHIC_3); + eval 'sub SOMETHING_ELSE_TRIGRAPHIC_4 () {"~0";}' unless defined(&SOMETHING_ELSE_TRIGRAPHIC_4); + eval 'sub SOMETHING_ELSE_TRIGRAPHIC_5 () {"\\ ";}' unless defined(&SOMETHING_ELSE_TRIGRAPHIC_5); + eval 'sub SOMETHING_ELSE_TRIGRAPHIC_6 () {"{";}' unless defined(&SOMETHING_ELSE_TRIGRAPHIC_6); + eval 'sub SOMETHING_ELSE_TRIGRAPHIC_7 () {"#";}' unless defined(&SOMETHING_ELSE_TRIGRAPHIC_7); + eval 'sub SOMETHING_ELSE_TRIGRAPHIC_8 () {"}";}' unless defined(&SOMETHING_ELSE_TRIGRAPHIC_8); + } + if(1) { + } + eval("sub flim () { 0; }") unless defined(&flim); + eval("sub flam () { 1; }") unless defined(&flam); } 1; diff --git a/gnu/usr.bin/perl/t/lib/locale/latin1 b/gnu/usr.bin/perl/t/lib/locale/latin1 new file mode 100644 index 00000000000..8499ca46ee5 --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/locale/latin1 @@ -0,0 +1,11 @@ +no utf8; # naked Latin-1 +$locales .= <<EOF; +Catal Catalan:ca:es:1 15 +Franais French:fr:be ca ch fr lu:1 15 +Gidhlig Gaelic:gd:gb uk:1 14 15 +Froyskt Faroese:fo:fo:1 15 +slensku Icelandic:is:is:1 15 +Smi Lappish:::4 6 13 +Portugus Portuguese:po:po br:1 15 +Espanl Spanish:es:ar bo cl co cr do ec es gt hn mx ni pa pe py sv uy ve:1 15 +EOF diff --git a/gnu/usr.bin/perl/t/lib/locale/utf8 b/gnu/usr.bin/perl/t/lib/locale/utf8 new file mode 100644 index 00000000000..69bc505038a --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/locale/utf8 @@ -0,0 +1,11 @@ +use utf8; +$locales .= <<EOF; +Català Catalan:ca:es:1 15 +Français French:fr:be ca ch fr lu:1 15 +Gáidhlig Gaelic:gd:gb uk:1 14 15 +Føroyskt Faroese:fo:fo:1 15 +Íslensku Icelandic:is:is:1 15 +Sámi Lappish:::4 6 13 +Português Portuguese:po:po br:1 15 +Espanõl Spanish:es:ar bo cl co cr do ec es gt hn mx ni pa pe py sv uy ve:1 15 +EOF diff --git a/gnu/usr.bin/perl/t/lib/sample-tests/bailout b/gnu/usr.bin/perl/t/lib/sample-tests/bailout new file mode 100644 index 00000000000..f67f673e7d3 --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/sample-tests/bailout @@ -0,0 +1,9 @@ +print <<DUMMY_TEST; +1..5 +ok 1 +ok 2 +ok 3 +Bail out! GERONIMMMOOOOOO!!! +ok 4 +ok 5 +DUMMY_TEST diff --git a/gnu/usr.bin/perl/t/lib/sample-tests/bignum b/gnu/usr.bin/perl/t/lib/sample-tests/bignum new file mode 100644 index 00000000000..3f51d38a424 --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/sample-tests/bignum @@ -0,0 +1,7 @@ +print <<DUMMY; +1..2 +ok 1 +ok 2 +ok 100001 +ok 136211425 +DUMMY diff --git a/gnu/usr.bin/perl/t/lib/sample-tests/combined b/gnu/usr.bin/perl/t/lib/sample-tests/combined new file mode 100644 index 00000000000..8dfaa28e926 --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/sample-tests/combined @@ -0,0 +1,13 @@ +print <<DUMMY_TEST; +1..10 todo 4 10 +ok 1 +ok 2 basset hounds got long ears +not ok 3 all hell broke lose +ok 4 +ok +ok 6 +ok 7 # Skip contract negociations +ok 8 +not ok 9 +not ok 10 +DUMMY_TEST diff --git a/gnu/usr.bin/perl/t/lib/sample-tests/descriptive b/gnu/usr.bin/perl/t/lib/sample-tests/descriptive new file mode 100644 index 00000000000..e165ac1bf5c --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/sample-tests/descriptive @@ -0,0 +1,8 @@ +print <<DUMMY_TEST; +1..5 +ok 1 Interlock activated +ok 2 Megathrusters are go +ok 3 Head formed +ok 4 Blazing sword formed +ok 5 Robeast destroyed +DUMMY_TEST diff --git a/gnu/usr.bin/perl/t/lib/sample-tests/die b/gnu/usr.bin/perl/t/lib/sample-tests/die new file mode 100644 index 00000000000..4c8534082da --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/sample-tests/die @@ -0,0 +1,2 @@ +use if ($^O eq 'VMS'), vmsish => 'hushed'; +exit 1; # exit because die() can be noisy diff --git a/gnu/usr.bin/perl/t/lib/sample-tests/die_head_end b/gnu/usr.bin/perl/t/lib/sample-tests/die_head_end new file mode 100644 index 00000000000..afcea1b3c83 --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/sample-tests/die_head_end @@ -0,0 +1,9 @@ +print <<DUMMY_TEST; +ok 1 +ok 2 +ok 3 +ok 4 +DUMMY_TEST + +use if $^O eq 'VMS', vmsish => 'hushed'; +exit 1; diff --git a/gnu/usr.bin/perl/t/lib/sample-tests/die_last_minute b/gnu/usr.bin/perl/t/lib/sample-tests/die_last_minute new file mode 100644 index 00000000000..e421dd1c0e2 --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/sample-tests/die_last_minute @@ -0,0 +1,10 @@ +print <<DUMMY_TEST; +ok 1 +ok 2 +ok 3 +ok 4 +1..4 +DUMMY_TEST + +use if $^O eq 'VMS', vmsish => 'hushed'; +exit 1; diff --git a/gnu/usr.bin/perl/t/lib/sample-tests/duplicates b/gnu/usr.bin/perl/t/lib/sample-tests/duplicates new file mode 100644 index 00000000000..63f6a706b63 --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/sample-tests/duplicates @@ -0,0 +1,14 @@ +print <<DUMMY_TEST +1..10 +ok 1 +ok 2 +ok 3 +ok 4 +ok 4 +ok 5 +ok 6 +ok 7 +ok 8 +ok 9 +ok 10 +DUMMY_TEST diff --git a/gnu/usr.bin/perl/t/lib/sample-tests/head_end b/gnu/usr.bin/perl/t/lib/sample-tests/head_end new file mode 100644 index 00000000000..14a32f2fe6b --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/sample-tests/head_end @@ -0,0 +1,11 @@ +print <<DUMMY_TEST; +# comments +ok 1 +ok 2 +ok 3 +ok 4 +# comment +1..4 +# more ignored stuff +# and yet more +DUMMY_TEST diff --git a/gnu/usr.bin/perl/t/lib/sample-tests/head_fail b/gnu/usr.bin/perl/t/lib/sample-tests/head_fail new file mode 100644 index 00000000000..9d1667ab19a --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/sample-tests/head_fail @@ -0,0 +1,11 @@ +print <<DUMMY_TEST; +# comments +ok 1 +not ok 2 +ok 3 +ok 4 +# comment +1..4 +# more ignored stuff +# and yet more +DUMMY_TEST diff --git a/gnu/usr.bin/perl/t/lib/sample-tests/lone_not_bug b/gnu/usr.bin/perl/t/lib/sample-tests/lone_not_bug new file mode 100644 index 00000000000..10eaa2a3b02 --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/sample-tests/lone_not_bug @@ -0,0 +1,9 @@ +# There was a bug where the first test would be considered a +# 'lone not' failure. +print <<DUMMY; +ok 1 +ok 2 +ok 3 +ok 4 +1..4 +DUMMY diff --git a/gnu/usr.bin/perl/t/lib/sample-tests/no_nums b/gnu/usr.bin/perl/t/lib/sample-tests/no_nums new file mode 100644 index 00000000000..c32d3f22baa --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/sample-tests/no_nums @@ -0,0 +1,8 @@ +print <<DUMMY_TEST; +1..5 +ok +ok +not ok +ok +ok +DUMMY_TEST diff --git a/gnu/usr.bin/perl/t/lib/sample-tests/out_of_order b/gnu/usr.bin/perl/t/lib/sample-tests/out_of_order new file mode 100644 index 00000000000..77641aa3620 --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/sample-tests/out_of_order @@ -0,0 +1,22 @@ +# From a bungled core thread test. +# +# The important thing here is that the last test is the right test. +# Test::Harness would misparse this as being a valid test. +print <<DUMMY; +ok 2 - Test that argument passing works +ok 3 - Test that passing arguments as references work +ok 4 - Test a normal sub +ok 6 - Detach test +ok 8 - Nested thread test +ok 9 - Nested thread test +ok 10 - Wanted 7, got 7 +ok 11 - Wanted 7, got 7 +ok 12 - Wanted 8, got 8 +ok 13 - Wanted 8, got 8 +1..15 +ok 1 +ok 5 - Check that Config::threads is true +ok 7 - Detach test +ok 14 - Check so that tid for threads work for main thread +ok 15 - Check so that tid for threads work for main thread +DUMMY diff --git a/gnu/usr.bin/perl/t/lib/sample-tests/shbang_misparse b/gnu/usr.bin/perl/t/lib/sample-tests/shbang_misparse new file mode 100644 index 00000000000..bc1b524a347 --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/sample-tests/shbang_misparse @@ -0,0 +1,12 @@ +#!/usr/bin/perl-latest + +# The above #! line was misparsed as having a -t. +# Pre-5.8 this will simply cause perl to choke, since there was no -t. +# Post-5.8 taint warnings will mistakenly be on. + +print "1..2\n"; +print "ok 1\n"; +my $warning = ''; +$SIG{__WARN__} = sub { $warning .= $_[0] }; +eval("#" . substr($0, 0, 0)); +print $warning ? "not ok 2\n" : "ok 2\n"; diff --git a/gnu/usr.bin/perl/t/lib/sample-tests/simple b/gnu/usr.bin/perl/t/lib/sample-tests/simple new file mode 100644 index 00000000000..d6b85846b26 --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/sample-tests/simple @@ -0,0 +1,8 @@ +print <<DUMMY_TEST; +1..5 +ok 1 +ok 2 +ok 3 +ok 4 +ok 5 +DUMMY_TEST diff --git a/gnu/usr.bin/perl/t/lib/sample-tests/simple_fail b/gnu/usr.bin/perl/t/lib/sample-tests/simple_fail new file mode 100644 index 00000000000..aa65f5f66de --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/sample-tests/simple_fail @@ -0,0 +1,8 @@ +print <<DUMMY_TEST; +1..5 +ok 1 +not ok 2 +ok 3 +ok 4 +not ok 5 +DUMMY_TEST diff --git a/gnu/usr.bin/perl/t/lib/sample-tests/skip b/gnu/usr.bin/perl/t/lib/sample-tests/skip new file mode 100644 index 00000000000..1b43d12f3b9 --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/sample-tests/skip @@ -0,0 +1,8 @@ +print <<DUMMY_TEST; +1..5 +ok 1 +ok 2 # skipped rain delay +ok 3 +ok 4 +ok 5 +DUMMY_TEST diff --git a/gnu/usr.bin/perl/t/lib/sample-tests/skip_nomsg b/gnu/usr.bin/perl/t/lib/sample-tests/skip_nomsg new file mode 100644 index 00000000000..51d1ed6b43f --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/sample-tests/skip_nomsg @@ -0,0 +1,4 @@ +print <<DUMMY; +1..1 +ok 1 # Skip +DUMMY diff --git a/gnu/usr.bin/perl/t/lib/sample-tests/skipall b/gnu/usr.bin/perl/t/lib/sample-tests/skipall new file mode 100644 index 00000000000..8c4679660c2 --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/sample-tests/skipall @@ -0,0 +1,3 @@ +print <<DUMMY_TEST; +1..0 # skip: rope +DUMMY_TEST diff --git a/gnu/usr.bin/perl/t/lib/sample-tests/skipall_nomsg b/gnu/usr.bin/perl/t/lib/sample-tests/skipall_nomsg new file mode 100644 index 00000000000..9b0dc11a697 --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/sample-tests/skipall_nomsg @@ -0,0 +1,2 @@ +print "1..0\n"; +exit 0; diff --git a/gnu/usr.bin/perl/t/lib/sample-tests/taint b/gnu/usr.bin/perl/t/lib/sample-tests/taint new file mode 100644 index 00000000000..42968d36e32 --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/sample-tests/taint @@ -0,0 +1,7 @@ +#!/usr/bin/perl -Tw + +use lib qw(t/lib); +use Test::More tests => 1; + +eval { kill 0, $^X }; +like( $@, '/^Insecure dependency/', '-T honored' ); diff --git a/gnu/usr.bin/perl/t/lib/sample-tests/todo b/gnu/usr.bin/perl/t/lib/sample-tests/todo new file mode 100644 index 00000000000..5620ee20ee0 --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/sample-tests/todo @@ -0,0 +1,8 @@ +print <<DUMMY_TEST; +1..5 todo 3 2; +ok 1 +ok 2 +not ok 3 +ok 4 +ok 5 +DUMMY_TEST diff --git a/gnu/usr.bin/perl/t/lib/sample-tests/todo_inline b/gnu/usr.bin/perl/t/lib/sample-tests/todo_inline new file mode 100644 index 00000000000..5b96d68caf2 --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/sample-tests/todo_inline @@ -0,0 +1,6 @@ +print <<DUMMY_TEST; +1..3 +not ok 1 - Foo # TODO Just testing the todo interface. +ok 2 - Unexpected success # TODO Just testing the todo interface. +ok 3 - This is not todo +DUMMY_TEST diff --git a/gnu/usr.bin/perl/t/lib/sample-tests/vms_nit b/gnu/usr.bin/perl/t/lib/sample-tests/vms_nit new file mode 100644 index 00000000000..1df7804309f --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/sample-tests/vms_nit @@ -0,0 +1,6 @@ +print <<DUMMY; +1..2 +not +ok 1 +ok 2 +DUMMY diff --git a/gnu/usr.bin/perl/t/lib/sample-tests/with_comments b/gnu/usr.bin/perl/t/lib/sample-tests/with_comments new file mode 100644 index 00000000000..7aa913985b1 --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/sample-tests/with_comments @@ -0,0 +1,14 @@ +print <<DUMMY_TEST; +# and stuff +1..5 todo 1 2 4 5; +# yeah, that +not ok 1 +# Failed test 1 in t/todo.t at line 9 *TODO* +ok 2 # (t/todo.t at line 10 TODO?!) +ok 3 +not ok 4 +# Test 4 got: '0' (t/todo.t at line 12 *TODO*) +# Expected: '1' (need more tuits) +ok 5 # (t/todo.t at line 13 TODO?!) +# woo +DUMMY_TEST diff --git a/gnu/usr.bin/perl/t/lib/strict/refs b/gnu/usr.bin/perl/t/lib/strict/refs new file mode 100644 index 00000000000..10599b0bb28 --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/strict/refs @@ -0,0 +1,297 @@ +Check strict refs functionality + +__END__ + +# no strict, should build & run ok. +my $fred ; +$b = "fred" ; +$a = $$b ; +$c = ${"def"} ; +$c = @{"def"} ; +$c = %{"def"} ; +$c = *{"def"} ; +$c = \&{"def"} ; +$c = def->[0]; +$c = def->{xyz}; +EXPECT + +######## + +# strict refs - error +use strict ; +my $fred ; +my $a = ${"fred"} ; +EXPECT +Can't use string ("fred") as a SCALAR ref while "strict refs" in use at - line 5. +######## + +# strict refs - error +use strict 'refs' ; +my $fred ; +my $a = ${"fred"} ; +EXPECT +Can't use string ("fred") as a SCALAR ref while "strict refs" in use at - line 5. +######## + +# strict refs - error +use strict 'refs' ; +my $fred ; +my $b = "fred" ; +my $a = $$b ; +EXPECT +Can't use string ("fred") as a SCALAR ref while "strict refs" in use at - line 6. +######## + +# strict refs - error +use strict 'refs' ; +my $b ; +my $a = $$b ; +EXPECT +Can't use an undefined value as a SCALAR reference at - line 5. +######## + +# strict refs - error +use strict 'refs' ; +my $b ; +my $a = @$b ; +EXPECT +Can't use an undefined value as an ARRAY reference at - line 5. +######## + +# strict refs - error +use strict 'refs' ; +my $b ; +my $a = %$b ; +EXPECT +Can't use an undefined value as a HASH reference at - line 5. +######## + +# strict refs - error +use strict 'refs' ; +my $b ; +my $a = *$b ; +EXPECT +Can't use an undefined value as a symbol reference at - line 5. +######## + +# strict refs - error +use strict 'refs' ; +my $a = fred->[0] ; +EXPECT +Can't use bareword ("fred") as an ARRAY ref while "strict refs" in use at - line 4. +######## + +# strict refs - error +use strict 'refs' ; +my $a = fred->{barney} ; +EXPECT +Can't use bareword ("fred") as a HASH ref while "strict refs" in use at - line 4. +######## + +# strict refs - no error +use strict ; +no strict 'refs' ; +my $fred ; +my $b = "fred" ; +my $a = $$b ; +use strict 'refs' ; +EXPECT + +######## + +# strict refs - no error +use strict qw(subs vars) ; +my $fred ; +my $b = "fred" ; +my $a = $$b ; +use strict 'refs' ; +EXPECT + +######## + +# strict refs - no error +my $fred ; +my $b = "fred" ; +my $a = $$b ; +use strict 'refs' ; +EXPECT + +######## + +# strict refs - no error +use strict 'refs' ; +my $fred ; +my $b = \$fred ; +my $a = $$b ; +EXPECT + +######## + +# Check runtime scope of strict refs pragma +use strict 'refs'; +my $fred ; +my $b = "fred" ; +{ + no strict ; + my $a = $$b ; +} +my $a = $$b ; +EXPECT +Can't use string ("fred") as a SCALAR ref while "strict refs" in use at - line 10. +######## + +# Check runtime scope of strict refs pragma +no strict ; +my $fred ; +my $b = "fred" ; +{ + use strict 'refs' ; + my $a = $$b ; +} +my $a = $$b ; +EXPECT +Can't use string ("fred") as a SCALAR ref while "strict refs" in use at - line 8. +######## + +# Check runtime scope of strict refs pragma +no strict ; +my $fred ; +my $b = "fred" ; +{ + use strict 'refs' ; + $a = sub { my $c = $$b ; } +} +&$a ; +EXPECT +Can't use string ("fred") as a SCALAR ref while "strict refs" in use at - line 8. +######## + + +--FILE-- abc +my $a = ${"Fred"} ; +1; +--FILE-- +use strict 'refs' ; +require "./abc"; +EXPECT + +######## + +--FILE-- abc +use strict 'refs' ; +1; +--FILE-- +require "./abc"; +my $a = ${"Fred"} ; +EXPECT + +######## + +--FILE-- abc +use strict 'refs' ; +my $a = ${"Fred"} ; +1; +--FILE-- +${"Fred"} ; +require "./abc"; +EXPECT +Can't use string ("Fred") as a SCALAR ref while "strict refs" in use at ./abc line 2. +Compilation failed in require at - line 2. +######## + +--FILE-- abc.pm +use strict 'refs' ; +my $a = ${"Fred"} ; +1; +--FILE-- +my $a = ${"Fred"} ; +use abc; +EXPECT +Can't use string ("Fred") as a SCALAR ref while "strict refs" in use at abc.pm line 2. +Compilation failed in require at - line 2. +BEGIN failed--compilation aborted at - line 2. +######## + +# Check scope of pragma with eval +no strict ; +eval { + my $a = ${"Fred"} ; +}; +print STDERR $@ ; +my $a = ${"Fred"} ; +EXPECT + +######## + +# Check scope of pragma with eval +no strict ; +eval { + use strict 'refs' ; + my $a = ${"Fred"} ; +}; +print STDERR $@ ; +my $a = ${"Fred"} ; +EXPECT +Can't use string ("Fred") as a SCALAR ref while "strict refs" in use at - line 6. +######## + +# Check scope of pragma with eval +use strict 'refs' ; +eval { + my $a = ${"Fred"} ; +}; +print STDERR $@ ; +EXPECT +Can't use string ("Fred") as a SCALAR ref while "strict refs" in use at - line 5. +######## + +# Check scope of pragma with eval +use strict 'refs' ; +eval { + no strict ; + my $a = ${"Fred"} ; +}; +print STDERR $@ ; +my $a = ${"Fred"} ; +EXPECT +Can't use string ("Fred") as a SCALAR ref while "strict refs" in use at - line 9. +######## + +# Check scope of pragma with eval +no strict ; +eval ' + my $a = ${"Fred"} ; +'; print STDERR $@ ; +my $a = ${"Fred"} ; +EXPECT + +######## + +# Check scope of pragma with eval +no strict ; +eval q[ + use strict 'refs' ; + my $a = ${"Fred"} ; +]; print STDERR $@; +EXPECT +Can't use string ("Fred") as a SCALAR ref while "strict refs" in use at (eval 1) line 3. +######## + +# Check scope of pragma with eval +use strict 'refs' ; +eval ' + my $a = ${"Fred"} ; +'; print STDERR $@ ; +EXPECT +Can't use string ("Fred") as a SCALAR ref while "strict refs" in use at (eval 1) line 2. +######## + +# Check scope of pragma with eval +use strict 'refs' ; +eval ' + no strict ; + my $a = ${"Fred"} ; +'; print STDERR $@; +my $a = ${"Fred"} ; +EXPECT +Can't use string ("Fred") as a SCALAR ref while "strict refs" in use at - line 8. diff --git a/gnu/usr.bin/perl/t/lib/strict/subs b/gnu/usr.bin/perl/t/lib/strict/subs new file mode 100644 index 00000000000..4a90809020f --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/strict/subs @@ -0,0 +1,347 @@ +Check strict subs functionality + +__END__ + +# no strict, should build & run ok. +Fred ; +my $fred ; +$b = "fred" ; +$a = $$b ; +EXPECT + +######## + +use strict qw(refs vars); +Fred ; +EXPECT + +######## + +use strict ; +no strict 'subs' ; +Fred ; +EXPECT + +######## + +# strict subs - error +use strict 'subs' ; +my @a = (1..2); +my $b = xyz; +EXPECT +Bareword "xyz" not allowed while "strict subs" in use at - line 5. +Execution of - aborted due to compilation errors. +######## + +# strict subs - error +use strict 'subs' ; +Fred ; +EXPECT +Bareword "Fred" not allowed while "strict subs" in use at - line 4. +Execution of - aborted due to compilation errors. +######## + +# strict subs - error +use strict 'subs' ; +my @a = (A..Z); +EXPECT +Bareword "Z" not allowed while "strict subs" in use at - line 4. +Bareword "A" not allowed while "strict subs" in use at - line 4. +Execution of - aborted due to compilation errors. +######## + +# strict subs - error +use strict 'subs' ; +my $a = (B..Y); +EXPECT +Bareword "Y" not allowed while "strict subs" in use at - line 4. +Bareword "B" not allowed while "strict subs" in use at - line 4. +Execution of - aborted due to compilation errors. +######## + +# strict subs - error +use strict ; +Fred ; +EXPECT +Bareword "Fred" not allowed while "strict subs" in use at - line 4. +Execution of - aborted due to compilation errors. +######## + +# strict subs - no error +use strict 'subs' ; +sub Fred {} +Fred ; +EXPECT + +######## + +# Check compile time scope of strict subs pragma +use strict 'subs' ; +{ + no strict ; + my $a = Fred ; +} +my $a = Fred ; +EXPECT +Bareword "Fred" not allowed while "strict subs" in use at - line 8. +Execution of - aborted due to compilation errors. +######## + +# Check compile time scope of strict subs pragma +no strict; +{ + use strict 'subs' ; + my $a = Fred ; +} +my $a = Fred ; +EXPECT +Bareword "Fred" not allowed while "strict subs" in use at - line 6. +Execution of - aborted due to compilation errors. +######## + +# Check compile time scope of strict vars pragma +use strict 'vars' ; +{ + no strict ; + $joe = 1 ; +} +$joe = 1 ; +EXPECT +Variable "$joe" is not imported at - line 8. +Global symbol "$joe" requires explicit package name at - line 8. +Execution of - aborted due to compilation errors. +######## + +# Check compile time scope of strict vars pragma +no strict; +{ + use strict 'vars' ; + $joe = 1 ; +} +$joe = 1 ; +EXPECT +Global symbol "$joe" requires explicit package name at - line 6. +Execution of - aborted due to compilation errors. +######## + +# Check runtime scope of strict refs pragma +use strict 'refs'; +my $fred ; +my $b = "fred" ; +{ + no strict ; + my $a = $$b ; +} +my $a = $$b ; +EXPECT +Can't use string ("fred") as a SCALAR ref while "strict refs" in use at - line 10. +######## + +# Check runtime scope of strict refs pragma +no strict ; +my $fred ; +my $b = "fred" ; +{ + use strict 'refs' ; + my $a = $$b ; +} +my $a = $$b ; +EXPECT +Can't use string ("fred") as a SCALAR ref while "strict refs" in use at - line 8. +######## + +# Check runtime scope of strict refs pragma +no strict ; +my $fred ; +my $b = "fred" ; +{ + use strict 'refs' ; + $a = sub { my $c = $$b ; } +} +&$a ; +EXPECT +Can't use string ("fred") as a SCALAR ref while "strict refs" in use at - line 8. +######## + +use strict 'subs' ; +my $a = Fred ; +EXPECT +Bareword "Fred" not allowed while "strict subs" in use at - line 3. +Execution of - aborted due to compilation errors. +######## + +--FILE-- abc +my $a = Fred ; +1; +--FILE-- +use strict 'subs' ; +require "./abc"; +EXPECT + +######## + +--FILE-- abc +use strict 'subs' ; +1; +--FILE-- +require "./abc"; +my $a = Fred ; +EXPECT + +######## + +--FILE-- abc +use strict 'subs' ; +my $a = Fred ; +1; +--FILE-- +Fred ; +require "./abc"; +EXPECT +Bareword "Fred" not allowed while "strict subs" in use at ./abc line 2. +Compilation failed in require at - line 2. +######## + +--FILE-- abc.pm +use strict 'subs' ; +my $a = Fred ; +1; +--FILE-- +Fred ; +use abc; +EXPECT +Bareword "Fred" not allowed while "strict subs" in use at abc.pm line 2. +Compilation failed in require at - line 2. +BEGIN failed--compilation aborted at - line 2. +######## + +# Check scope of pragma with eval +no strict ; +eval { + my $a = Fred ; +}; +print STDERR $@; +my $a = Fred ; +EXPECT + +######## + +# Check scope of pragma with eval +no strict ; +eval { + use strict 'subs' ; + my $a = Fred ; +}; +print STDERR $@; +my $a = Fred ; +EXPECT +Bareword "Fred" not allowed while "strict subs" in use at - line 6. +Execution of - aborted due to compilation errors. +######## + +# Check scope of pragma with eval +use strict 'subs' ; +eval { + my $a = Fred ; +}; +print STDERR $@; +my $a = Fred ; +EXPECT +Bareword "Fred" not allowed while "strict subs" in use at - line 5. +Bareword "Fred" not allowed while "strict subs" in use at - line 8. +Execution of - aborted due to compilation errors. +######## + +# Check scope of pragma with eval +use strict 'subs' ; +eval { + no strict ; + my $a = Fred ; +}; +print STDERR $@; +my $a = Fred ; +EXPECT +Bareword "Fred" not allowed while "strict subs" in use at - line 9. +Execution of - aborted due to compilation errors. +######## + +# Check scope of pragma with eval +no strict ; +eval ' + Fred ; +'; print STDERR $@ ; +Fred ; +EXPECT + +######## + +# Check scope of pragma with eval +no strict ; +eval q[ + use strict 'subs' ; + Fred ; +]; print STDERR $@; +EXPECT +Bareword "Fred" not allowed while "strict subs" in use at (eval 1) line 3. +######## + +# Check scope of pragma with eval +use strict 'subs' ; +eval ' + Fred ; +'; print STDERR $@ ; +EXPECT +Bareword "Fred" not allowed while "strict subs" in use at (eval 1) line 2. +######## + +# Check scope of pragma with eval +use strict 'subs' ; +eval ' + no strict ; + my $a = Fred ; +'; print STDERR $@; +my $a = Fred ; +EXPECT +Bareword "Fred" not allowed while "strict subs" in use at - line 8. +Execution of - aborted due to compilation errors. +######## + +# see if Foo->Bar(...) etc work under strictures +use strict; +package Foo; sub Bar { print "@_\n" } +Foo->Bar('a',1); +Bar Foo ('b',2); +Foo->Bar(qw/c 3/); +Bar Foo (qw/d 4/); +Foo::->Bar('A',1); +Bar Foo:: ('B',2); +Foo::->Bar(qw/C 3/); +Bar Foo:: (qw/D 4/); +EXPECT +Foo a 1 +Foo b 2 +Foo c 3 +Foo d 4 +Foo A 1 +Foo B 2 +Foo C 3 +Foo D 4 +######## + +# Check that barewords on the RHS of a regex match are caught +use strict; +"" =~ foo; +EXPECT +Bareword "foo" not allowed while "strict subs" in use at - line 4. +Execution of - aborted due to compilation errors. + +######## + +# ID 20020703.002 +use strict; +use warnings; +my $abc = XYZ ? 1 : 0; +print "$abc\n"; +EXPECT +Bareword "XYZ" not allowed while "strict subs" in use at - line 5. +Execution of - aborted due to compilation errors. diff --git a/gnu/usr.bin/perl/t/lib/strict/vars b/gnu/usr.bin/perl/t/lib/strict/vars new file mode 100644 index 00000000000..de517078be1 --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/strict/vars @@ -0,0 +1,423 @@ +Check strict vars functionality + +__END__ + +# no strict, should build & run ok. +Fred ; +my $fred ; +$b = "fred" ; +$a = $$b ; +EXPECT + +######## + +use strict qw(subs refs) ; +$fred ; +EXPECT + +######## + +use strict ; +no strict 'vars' ; +$fred ; +EXPECT + +######## + +# strict vars - no error +use strict 'vars' ; +use vars qw( $freddy) ; +BEGIN { *freddy = \$joe::shmoe; } +$freddy = 2 ; +EXPECT + +######## + +# strict vars - no error +use strict 'vars' ; +use vars qw( $freddy) ; +local $abc::joe ; +my $fred ; +my $b = \$fred ; +$Fred::ABC = 1 ; +$freddy = 2 ; +EXPECT + +######## + +# strict vars - error +use strict ; +$fred ; +EXPECT +Global symbol "$fred" requires explicit package name at - line 4. +Execution of - aborted due to compilation errors. +######## + +# strict vars - error +use strict 'vars' ; +<$fred> ; +EXPECT +Global symbol "$fred" requires explicit package name at - line 4. +Execution of - aborted due to compilation errors. +######## + +# strict vars - error +use strict 'vars' ; +local $fred ; +EXPECT +Global symbol "$fred" requires explicit package name at - line 4. +Execution of - aborted due to compilation errors. +######## + +# Check compile time scope of strict vars pragma +use strict 'vars' ; +{ + no strict ; + $joe = 1 ; +} +$joe = 1 ; +EXPECT +Variable "$joe" is not imported at - line 8. +Global symbol "$joe" requires explicit package name at - line 8. +Execution of - aborted due to compilation errors. +######## + +# Check compile time scope of strict vars pragma +no strict; +{ + use strict 'vars' ; + $joe = 1 ; +} +$joe = 1 ; +EXPECT +Global symbol "$joe" requires explicit package name at - line 6. +Execution of - aborted due to compilation errors. +######## + +--FILE-- abc +$joe = 1 ; +1; +--FILE-- +use strict 'vars' ; +require "./abc"; +EXPECT + +######## + +--FILE-- abc +use strict 'vars' ; +1; +--FILE-- +require "./abc"; +$joe = 1 ; +EXPECT + +######## + +--FILE-- abc +use strict 'vars' ; +$joe = 1 ; +1; +--FILE-- +$joe = 1 ; +require "./abc"; +EXPECT +Variable "$joe" is not imported at ./abc line 2. +Global symbol "$joe" requires explicit package name at ./abc line 2. +Compilation failed in require at - line 2. +######## + +--FILE-- abc.pm +use strict 'vars' ; +$joe = 1 ; +1; +--FILE-- +$joe = 1 ; +use abc; +EXPECT +Variable "$joe" is not imported at abc.pm line 2. +Global symbol "$joe" requires explicit package name at abc.pm line 2. +Compilation failed in require at - line 2. +BEGIN failed--compilation aborted at - line 2. +######## + +--FILE-- abc.pm +package Burp; +use strict; +$a = 1;$f = 1;$k = 1; # just to get beyond the limit... +$b = 1;$g = 1;$l = 1; +$c = 1;$h = 1;$m = 1; +$d = 1;$i = 1;$n = 1; +$e = 1;$j = 1;$o = 1; +$p = 0b12; +--FILE-- +use abc; +EXPECT +Global symbol "$f" requires explicit package name at abc.pm line 3. +Global symbol "$k" requires explicit package name at abc.pm line 3. +Global symbol "$g" requires explicit package name at abc.pm line 4. +Global symbol "$l" requires explicit package name at abc.pm line 4. +Global symbol "$c" requires explicit package name at abc.pm line 5. +Global symbol "$h" requires explicit package name at abc.pm line 5. +Global symbol "$m" requires explicit package name at abc.pm line 5. +Global symbol "$d" requires explicit package name at abc.pm line 6. +Global symbol "$i" requires explicit package name at abc.pm line 6. +Global symbol "$n" requires explicit package name at abc.pm line 6. +Global symbol "$e" requires explicit package name at abc.pm line 7. +Global symbol "$j" requires explicit package name at abc.pm line 7. +Global symbol "$o" requires explicit package name at abc.pm line 7. +Global symbol "$p" requires explicit package name at abc.pm line 8. +Illegal binary digit '2' at abc.pm line 8, at end of line +abc.pm has too many errors. +Compilation failed in require at - line 1. +BEGIN failed--compilation aborted at - line 1. +######## + +# Check scope of pragma with eval +no strict ; +eval { + $joe = 1 ; +}; +print STDERR $@; +$joe = 1 ; +EXPECT + +######## + +# Check scope of pragma with eval +no strict ; +eval { + use strict 'vars' ; + $joe = 1 ; +}; +print STDERR $@; +$joe = 1 ; +EXPECT +Global symbol "$joe" requires explicit package name at - line 6. +Execution of - aborted due to compilation errors. +######## + +# Check scope of pragma with eval +use strict 'vars' ; +eval { + $joe = 1 ; +}; +print STDERR $@; +$joe = 1 ; +EXPECT +Global symbol "$joe" requires explicit package name at - line 5. +Global symbol "$joe" requires explicit package name at - line 8. +Execution of - aborted due to compilation errors. +######## + +# Check scope of pragma with eval +use strict 'vars' ; +eval { + no strict ; + $joe = 1 ; +}; +print STDERR $@; +$joe = 1 ; +EXPECT +Variable "$joe" is not imported at - line 9. +Global symbol "$joe" requires explicit package name at - line 9. +Execution of - aborted due to compilation errors. +######## + +# Check scope of pragma with eval +no strict ; +eval ' + $joe = 1 ; +'; print STDERR $@ ; +$joe = 1 ; +EXPECT + +######## + +# Check scope of pragma with eval +no strict ; +eval q[ + use strict 'vars' ; + $joe = 1 ; +]; print STDERR $@; +EXPECT +Global symbol "$joe" requires explicit package name at (eval 1) line 3. +######## + +# Check scope of pragma with eval +use strict 'vars' ; +eval ' + $joe = 1 ; +'; print STDERR $@ ; +EXPECT +Global symbol "$joe" requires explicit package name at (eval 1) line 2. +######## + +# Check scope of pragma with eval +use strict 'vars' ; +eval ' + no strict ; + $joe = 1 ; +'; print STDERR $@; +$joe = 1 ; +EXPECT +Global symbol "$joe" requires explicit package name at - line 8. +Execution of - aborted due to compilation errors. +######## + +# Check if multiple evals produce same errors +use strict 'vars'; +my $ret = eval q{ print $x; }; +print $@; +print "ok 1\n" unless defined $ret; +$ret = eval q{ print $x; }; +print $@; +print "ok 2\n" unless defined $ret; +EXPECT +Global symbol "$x" requires explicit package name at (eval 1) line 1. +ok 1 +Global symbol "$x" requires explicit package name at (eval 2) line 1. +ok 2 +######## + +# strict vars with outer our - no error +use strict 'vars' ; +our $freddy; +local $abc::joe ; +my $fred ; +my $b = \$fred ; +$Fred::ABC = 1 ; +$freddy = 2 ; +EXPECT + +######## + +# strict vars with inner our - no error +use strict 'vars' ; +sub foo { + our $fred; + $fred; +} +EXPECT + +######## + +# strict vars with outer our, inner use - no error +use strict 'vars' ; +our $fred; +sub foo { + $fred; +} +EXPECT + +######## + +# strict vars with nested our - no error +use strict 'vars' ; +our $fred; +sub foo { + our $fred; + $fred; +} +$fred ; +EXPECT + +######## + +# strict vars with elapsed our - error +use strict 'vars' ; +sub foo { + our $fred; + $fred; +} +$fred ; +EXPECT +Variable "$fred" is not imported at - line 8. +Global symbol "$fred" requires explicit package name at - line 8. +Execution of - aborted due to compilation errors. +######## + +# nested our with local - no error +$fred = 1; +use strict 'vars'; +{ + local our $fred = 2; + print $fred,"\n"; +} +print our $fred,"\n"; +EXPECT +2 +1 +######## + +# "nailed" our declaration visibility across package boundaries +use strict 'vars'; +our $foo; +$foo = 20; +package Foo; +print $foo, "\n"; +EXPECT +20 +######## + +# multiple our declarations in same scope, different packages, no warning +use strict 'vars'; +use warnings; +our $foo; +${foo} = 10; +package Foo; +our $foo = 20; +print $foo, "\n"; +EXPECT +20 +######## + +# multiple our declarations in same scope, same package, warning +use strict 'vars'; +use warnings; +our $foo; +${foo} = 10; +our $foo; +EXPECT +"our" variable $foo masks earlier declaration in same scope at - line 7. +######## + +# multiple our declarations in same scope, same package, warning +use strict 'vars'; +use warnings; +{ our $x = 1 } +{ our $x = 0 } +our $foo; +{ + our $foo; + package Foo; + our $foo; +} +EXPECT +"our" variable $foo redeclared at - line 9. + (Did you mean "local" instead of "our"?) +######## + +--FILE-- abc +ok +--FILE-- +# check if our variables are introduced correctly in readline() +package Foo; +use strict 'vars'; +our $FH; +open $FH, "abc" or die "Can't open 'abc': $!"; +print <$FH>; +close $FH; +EXPECT +ok +######## + +# Make sure the strict vars failure still occurs +# now that the `@i should be written as \@i' failure does not occur +# 20000522 mjd@plover.com (MJD) +use strict 'vars'; +no warnings; +"@i_like_crackers"; +EXPECT +Global symbol "@i_like_crackers" requires explicit package name at - line 7. +Execution of - aborted due to compilation errors. diff --git a/gnu/usr.bin/perl/t/lib/warnings/1global b/gnu/usr.bin/perl/t/lib/warnings/1global new file mode 100644 index 00000000000..0af80221b25 --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/warnings/1global @@ -0,0 +1,189 @@ +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. +Name "main::a" used only once: possible typo at - line 3. +######## +#! perl -w +# warnable code, warnings enabled via #! line +$a =+ 3 ; +EXPECT +Reversed += operator at - line 3. +Name "main::a" used only once: possible typo at - line 3. +######## + +# warnable code, warnings enabled via compile time $^W +BEGIN { $^W = 1 } +$a =+ 3 ; +EXPECT +Reversed += operator at - line 4. +Name "main::a" used only once: possible typo 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 in scalar chop 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 in scalar chop at - line 5. +######## +-w +--FILE-- abcd +my $b ; chop $b ; +1 ; +--FILE-- +require "./abcd"; +EXPECT +Use of uninitialized value in scalar chop at ./abcd line 1. +######## + +--FILE-- abcd +my $b ; chop $b ; +1 ; +--FILE-- +#! perl -w +require "./abcd"; +EXPECT +Use of uninitialized value in scalar chop at ./abcd line 1. +######## + +--FILE-- abcd +my $b ; chop $b ; +1 ; +--FILE-- +$^W =1 ; +require "./abcd"; +EXPECT +Use of uninitialized value in scalar chop 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 in scalar chop at - line 3. +######## + +$^W = 1; +eval 'my $b ; chop $b ;' ; +print $@ ; +EXPECT +Use of uninitialized value in scalar chop at (eval 1) line 1. +######## + +eval '$^W = 1;' ; +print $@ ; +my $b ; chop $b ; +EXPECT +Use of uninitialized value in scalar chop at - line 4. +######## + +eval {$^W = 1;} ; +print $@ ; +my $b ; chop $b ; +EXPECT +Use of uninitialized value in scalar chop 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 in scalar chop at - line 5. +######## +-w +-e undef +EXPECT +Use of uninitialized value in -e 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 in scalar chop at - line 2. diff --git a/gnu/usr.bin/perl/t/lib/warnings/2use b/gnu/usr.bin/perl/t/lib/warnings/2use new file mode 100644 index 00000000000..b700ef70dc0 --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/warnings/2use @@ -0,0 +1,354 @@ +Check lexical warnings functionality + +TODO + check that the warning hierarchy works. + +__END__ + +# check illegal category is caught +use warnings 'this-should-never-be-a-warning-category' ; +EXPECT +Unknown warnings category 'this-should-never-be-a-warning-category' at - line 3 +BEGIN failed--compilation aborted at - line 3. +######## + +# Check compile time scope of pragma +use warnings 'syntax' ; +{ + no warnings ; + my $a =+ 1 ; +} +my $a =+ 1 ; +EXPECT +Reversed += operator at - line 8. +######## + +# Check compile time scope of pragma +no warnings; +{ + use warnings 'syntax' ; + my $a =+ 1 ; +} +my $a =+ 1 ; +EXPECT +Reversed += operator at - line 6. +######## + +# Check runtime scope of pragma +use warnings 'uninitialized' ; +{ + no warnings ; + my $b ; chop $b ; +} +my $b ; chop $b ; +EXPECT +Use of uninitialized value in scalar chop at - line 8. +######## + +# Check runtime scope of pragma +no warnings ; +{ + use warnings 'uninitialized' ; + my $b ; chop $b ; +} +my $b ; chop $b ; +EXPECT +Use of uninitialized value in scalar chop at - line 6. +######## + +# Check runtime scope of pragma +no warnings ; +{ + use warnings 'uninitialized' ; + $a = sub { my $b ; chop $b ; } +} +&$a ; +EXPECT +Use of uninitialized value in scalar chop at - line 6. +######## + +use warnings 'syntax' ; +my $a =+ 1 ; +EXPECT +Reversed += operator at - line 3. +######## + +--FILE-- abc +my $a =+ 1 ; +1; +--FILE-- +use warnings 'syntax' ; +require "./abc"; +EXPECT + +######## + +--FILE-- abc +use warnings 'syntax' ; +1; +--FILE-- +require "./abc"; +my $a =+ 1 ; +EXPECT + +######## + +--FILE-- abc +use warnings 'syntax' ; +my $a =+ 1 ; +1; +--FILE-- +use warnings 'uninitialized' ; +require "./abc"; +my $a ; chop $a ; +EXPECT +Reversed += operator at ./abc line 2. +Use of uninitialized value in scalar chop at - line 3. +######## + +--FILE-- abc.pm +use warnings 'syntax' ; +my $a =+ 1 ; +1; +--FILE-- +use warnings 'uninitialized' ; +use abc; +my $a ; chop $a ; +EXPECT +Reversed += operator at abc.pm line 2. +Use of uninitialized value in scalar chop at - line 3. +######## + +# Check scope of pragma with eval +use warnings; +{ + no warnings ; + eval { + my $b ; chop $b ; + }; print STDERR $@ ; + my $b ; chop $b ; +} +EXPECT + +######## + +# Check scope of pragma with eval +use warnings; +{ + no warnings ; + eval { + use warnings 'uninitialized' ; + my $b ; chop $b ; + }; print STDERR $@ ; + my $b ; chop $b ; +} +EXPECT +Use of uninitialized value in scalar chop at - line 8. +######## + +# 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 - line 7. +Use of uninitialized value in scalar chop at - line 9. +######## + +# 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 - line 10. +######## + +# Check scope of pragma with eval +use warnings; +{ + no warnings ; + eval { + my $a =+ 1 ; + }; print STDERR $@ ; + my $a =+ 1 ; +} +EXPECT + +######## + +# Check scope of pragma with eval +use warnings; +{ + no warnings ; + eval { + use warnings 'syntax' ; + my $a =+ 1 ; + }; print STDERR $@ ; + my $a =+ 1 ; +} +EXPECT +Reversed += operator at - line 8. +######## + +# Check scope of pragma with eval +no warnings; +{ + use warnings 'syntax' ; + eval { + my $a =+ 1 ; + }; print STDERR $@ ; + my $a =+ 1 ; +} +EXPECT +Reversed += operator at - line 7. +Reversed += operator at - line 9. +######## + +# Check scope of pragma with eval +no warnings; +{ + use warnings 'syntax' ; + eval { + no warnings ; + my $a =+ 1 ; + }; print STDERR $@ ; + my $a =+ 1 ; +} +EXPECT +Reversed += operator at - line 10. +######## + +# Check scope of pragma with eval +use warnings; +{ + no warnings ; + eval ' + my $b ; chop $b ; + '; print STDERR $@ ; + my $b ; chop $b ; +} +EXPECT + +######## + +# 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. +######## + +# 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. +######## + +# 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 - line 10. +######## + +# Check scope of pragma with eval +use warnings; +{ + no warnings ; + eval ' + my $a =+ 1 ; + '; print STDERR $@ ; + my $a =+ 1 ; +} +EXPECT + +######## + +# Check scope of pragma with eval +use warnings; +{ + no warnings ; + eval q[ + use warnings 'syntax' ; + my $a =+ 1 ; + ]; print STDERR $@; + my $a =+ 1 ; +} +EXPECT +Reversed += operator at (eval 1) line 3. +######## + +# Check scope of pragma with eval +no warnings; +{ + use warnings 'syntax' ; + eval ' + my $a =+ 1 ; + '; print STDERR $@; + my $a =+ 1 ; +} +EXPECT +Reversed += operator at - line 9. +Reversed += operator at (eval 1) line 2. +######## + +# Check scope of pragma with eval +no warnings; +{ + use warnings 'syntax' ; + eval ' + no warnings ; + my $a =+ 1 ; + '; print STDERR $@; + my $a =+ 1 ; +} +EXPECT +Reversed += operator at - line 10. +######## + +# Check the additive nature of the pragma +my $a =+ 1 ; +my $a ; chop $a ; +use warnings 'syntax' ; +$a =+ 1 ; +my $b ; chop $b ; +use warnings 'uninitialized' ; +my $c ; chop $c ; +no warnings 'syntax' ; +$a =+ 1 ; +EXPECT +Reversed += operator at - line 6. +Use of uninitialized value in scalar chop at - line 9. diff --git a/gnu/usr.bin/perl/t/lib/warnings/3both b/gnu/usr.bin/perl/t/lib/warnings/3both new file mode 100644 index 00000000000..a4d9ba806d6 --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/warnings/3both @@ -0,0 +1,266 @@ +Check interaction of $^W and lexical + +__END__ + +# Check interaction of $^W and use warnings +sub fred { + use warnings ; + my $b ; + chop $b ; +} +{ local $^W = 0 ; + fred() ; +} + +EXPECT +Use of uninitialized value in scalar chop at - line 6. +######## + +# Check interaction of $^W and use warnings +sub fred { + use warnings ; + my $b ; + chop $b ; +} +{ $^W = 0 ; + fred() ; +} + +EXPECT +Use of uninitialized value in scalar chop at - line 6. +######## + +# Check interaction of $^W and use warnings +sub fred { + no warnings ; + my $b ; + chop $b ; +} +{ local $^W = 1 ; + fred() ; +} + +EXPECT + +######## + +# Check interaction of $^W and use warnings +sub fred { + no warnings ; + my $b ; + chop $b ; +} +{ $^W = 1 ; + fred() ; +} + +EXPECT + +######## + +# Check interaction of $^W and use warnings +use warnings ; +$^W = 1 ; +my $b ; +chop $b ; +EXPECT +Use of uninitialized value in scalar chop at - line 6. +######## + +# Check interaction of $^W and use warnings +$^W = 1 ; +use warnings ; +my $b ; +chop $b ; +EXPECT +Use of uninitialized value in scalar chop at - line 6. +######## + +# Check interaction of $^W and use warnings +$^W = 1 ; +no warnings ; +my $b ; +chop $b ; +EXPECT + +######## + +# Check interaction of $^W and use warnings +no warnings ; +$^W = 1 ; +my $b ; +chop $b ; +EXPECT + +######## +-w +# Check interaction of $^W and use warnings +no warnings ; +my $b ; +chop $b ; +EXPECT + +######## +-w +# Check interaction of $^W and use warnings +use warnings ; +my $b ; +chop $b ; +EXPECT +Use of uninitialized value in scalar chop at - line 5. +######## + +# Check interaction of $^W and use warnings +sub fred { + use warnings ; + my $b ; + chop $b ; +} +BEGIN { $^W = 0 } +fred() ; +EXPECT +Use of uninitialized value in scalar chop at - line 6. +######## + +# Check interaction of $^W and use warnings +sub fred { + no warnings ; + my $b ; + chop $b ; +} +BEGIN { $^W = 1 } +fred() ; + +EXPECT + +######## + +# Check interaction of $^W and use warnings +use warnings ; +BEGIN { $^W = 1 } +my $b ; +chop $b ; +EXPECT +Use of uninitialized value in scalar chop at - line 6. +######## + +# Check interaction of $^W and use warnings +BEGIN { $^W = 1 } +use warnings ; +my $b ; +chop $b ; +EXPECT +Use of uninitialized value in scalar chop at - line 6. +######## + +# Check interaction of $^W and use warnings +BEGIN { $^W = 1 } +no warnings ; +my $b ; +chop $b ; +EXPECT + +######## + +# Check interaction of $^W and use warnings +no warnings ; +BEGIN { $^W = 1 } +my $b ; +chop $b ; +EXPECT + +######## + +# Check interaction of $^W and use warnings +BEGIN { $^W = 1 } +{ + no warnings ; + my $b ; + chop $b ; +} +my $b ; +chop $b ; +EXPECT +Use of uninitialized value in scalar chop at - line 10. +######## + +# Check interaction of $^W and use warnings +BEGIN { $^W = 0 } +{ + use warnings ; + my $b ; + chop $b ; +} +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 ' + my $a =+ 1 ; + '; print STDERR $@ ; + my $a =+ 1 ; +} +EXPECT + diff --git a/gnu/usr.bin/perl/t/lib/warnings/4lint b/gnu/usr.bin/perl/t/lib/warnings/4lint new file mode 100644 index 00000000000..805bd98905e --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/warnings/4lint @@ -0,0 +1,219 @@ +Check lint + +__END__ +-W +# lint: check compile time $^W is zapped +BEGIN { $^W = 0 ;} +$a = 1 ; +$a =+ 1 ; +close STDIN ; print STDIN "abc" ; +EXPECT +Reversed += operator at - line 5. +print() on closed filehandle STDIN at - line 6. +######## +-W +# lint: check runtime $^W is zapped +$^W = 0 ; +close STDIN ; print STDIN "abc" ; +EXPECT +print() on closed filehandle STDIN at - line 4. +######## +-W +# lint: check runtime $^W is zapped +{ + $^W = 0 ; + close STDIN ; print STDIN "abc" ; +} +EXPECT +print() on closed filehandle STDIN at - line 5. +######## +-W +# lint: check "no warnings" is zapped +no warnings ; +$a = 1 ; +$a =+ 1 ; +close STDIN ; print STDIN "abc" ; +EXPECT +Reversed += operator at - line 5. +print() on closed filehandle STDIN at - line 6. +######## +-W +# lint: check "no warnings" is zapped +{ + no warnings ; + close STDIN ; print STDIN "abc" ; +} +EXPECT +print() on closed filehandle STDIN at - line 5. +######## +-Ww +# lint: check combination of -w and -W +{ + $^W = 0 ; + close STDIN ; print STDIN "abc" ; +} +EXPECT +print() on closed filehandle STDIN at - line 5. +######## +-W +--FILE-- abc.pm +package abc; +no warnings 'syntax' ; +my $a = 0; +$a =+ 1 ; +1; +--FILE-- +no warnings 'uninitialized' ; +use abc; +my $a ; chop $a ; +EXPECT +Reversed += operator at abc.pm line 4. +Use of uninitialized value in scalar chop at - line 3. +######## +-W +--FILE-- abc +package abc; +no warnings 'syntax' ; +my $a = 0; +$a =+ 1 ; +1; +--FILE-- +no warnings 'uninitialized' ; +require "./abc"; +my $a ; chop $a ; +EXPECT +Reversed += operator at ./abc line 4. +Use of uninitialized value in scalar chop at - line 3. +######## +-W +--FILE-- abc.pm +package abc; +BEGIN {$^W = 0} +my $a = 0 ; +$a =+ 1 ; +1; +--FILE-- +$^W = 0 ; +use abc; +my $a ; chop $a ; +EXPECT +Reversed += operator at abc.pm line 4. +Use of uninitialized value in scalar chop at - line 3. +######## +-W +--FILE-- abc +BEGIN {$^W = 0} +my $a = 0 ; +$a =+ 1 ; +1; +--FILE-- +$^W = 0 ; +require "./abc"; +my $a ; chop $a ; +EXPECT +Reversed += operator 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 'syntax' ; + $a =+ 1 ; + ]; print STDERR $@; + $a =+ 1 ; +} +EXPECT +Reversed += operator at - line 11. +Reversed += operator at (eval 1) line 3. +######## +-W +# Check scope of pragma with eval +no warnings; +{ + my $a = "1"; my $b = "2"; + use warnings 'syntax' ; + eval ' + $a =+ 1 ; + '; print STDERR $@; + $a =+ 1 ; +} +EXPECT +Reversed += operator at - line 10. +Reversed += operator at (eval 1) line 2. +######## +-W +# Check scope of pragma with eval +no warnings; +{ + my $a = "1"; my $b = "2"; + use warnings 'syntax' ; + eval ' + no warnings ; + $a =+ 1 ; + '; print STDERR $@; + $a =+ 1 ; +} +EXPECT +Reversed += operator at - line 11. +Reversed += operator at (eval 1) line 3. diff --git a/gnu/usr.bin/perl/t/lib/warnings/5nolint b/gnu/usr.bin/perl/t/lib/warnings/5nolint new file mode 100644 index 00000000000..56158a20bef --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/warnings/5nolint @@ -0,0 +1,204 @@ +syntax anti-lint + +__END__ +-X +# nolint: check compile time $^W is zapped +BEGIN { $^W = 1 ;} +$a = $b = 1 ; +$a =+ 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 runtime $^W is zapped +{ + $^W = 1 ; + close STDIN ; print STDIN "abc" ; +} +EXPECT +######## +-X +# nolint: check "no warnings" is zapped +use warnings ; +$a = $b = 1 ; +$a =+ 1 ; +close STDIN ; print STDIN "abc" ; +EXPECT +######## +-X +# nolint: check "no warnings" is zapped +{ + use warnings ; + 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 warnings 'syntax' ; +my $a = 0; +$a =+ 1 ; +1; +--FILE-- +use warnings 'uninitialized' ; +use abc; +my $a ; chop $a ; +EXPECT +######## +-X +--FILE-- abc +use warnings 'syntax' ; +my $a = 0; +$a =+ 1 ; +1; +--FILE-- +use warnings 'uninitialized' ; +require "./abc"; +my $a ; chop $a ; +EXPECT +######## +-X +--FILE-- abc.pm +BEGIN {$^W = 1} +my ($a, $b) = (0,0); +$a =+ 1 ; +1; +--FILE-- +$^W = 1 ; +use abc; +my $a ; chop $a ; +EXPECT +######## +-X +--FILE-- abc +BEGIN {$^W = 1} +my ($a, $b) = (0,0); +$a =+ 1 ; +1; +--FILE-- +$^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 ' + my $a =+ 1 ; + '; print STDERR $@ ; + my $a =+ 1 ; +} +EXPECT + +######## +-X +# Check scope of pragma with eval +use warnings; +{ + no warnings ; + eval q[ + use warnings 'syntax' ; + my $a =+ 1 ; + ]; print STDERR $@; + my $a =+ 1 ; +} +EXPECT + +######## +-X +# Check scope of pragma with eval +no warnings; +{ + use warnings 'syntax' ; + eval ' + my $a =+ 1 ; + '; print STDERR $@; + my $a =+ 1 ; +} +EXPECT + +######## +-X +# Check scope of pragma with eval +no warnings; +{ + use warnings 'syntax' ; + eval ' + no warnings ; + my $a =+ 1 ; + '; print STDERR $@; + my $a =+ 1 ; +} +EXPECT + diff --git a/gnu/usr.bin/perl/t/lib/warnings/6default b/gnu/usr.bin/perl/t/lib/warnings/6default new file mode 100644 index 00000000000..a8aafeeb225 --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/warnings/6default @@ -0,0 +1,121 @@ +Check default warnings + +__END__ +# default warnings should be displayed if you don't add anything +# optional shouldn't +my $a = oct "7777777777777777777777777777777777779" ; +EXPECT +Integer overflow in octal number at - line 3. +######## +# no warnings should be displayed +no warnings ; +my $a = oct "7777777777777777777777777777777777778" ; +EXPECT +######## +# all warnings should be displayed +use warnings ; +my $a = oct "7777777777777777777777777777777777778" ; +EXPECT +Integer overflow in octal number at - line 3. +Illegal octal digit '8' ignored at - line 3. +Octal number > 037777777777 non-portable at - line 3. +######## +# check scope +use warnings ; +my $a = oct "7777777777777777777777777777777777778" ; +{ + no warnings ; + my $a = oct "7777777777777777777777777777777777778" ; +} +my $c = oct "7777777777777777777777777777777777778" ; +EXPECT +Integer overflow in octal number at - line 3. +Illegal octal digit '8' ignored at - line 3. +Octal number > 037777777777 non-portable at - line 3. +Integer overflow in octal number at - line 8. +Illegal octal digit '8' ignored at - line 8. +Octal number > 037777777777 non-portable at - line 8. +######## +# all warnings should be displayed +use warnings ; +my $a = oct "0xfffffffffffffffffg" ; +EXPECT +Integer overflow in hexadecimal number at - line 3. +Illegal hexadecimal digit 'g' ignored at - line 3. +Hexadecimal number > 0xffffffff non-portable at - line 3. +######## +# all warnings should be displayed +use warnings ; +my $a = oct "0b111111111111111111111111111111111111111111111111111111111111111112"; +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 + diff --git a/gnu/usr.bin/perl/t/lib/warnings/7fatal b/gnu/usr.bin/perl/t/lib/warnings/7fatal new file mode 100644 index 00000000000..a3e70f8d50f --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/warnings/7fatal @@ -0,0 +1,426 @@ +Check FATAL functionality + +__END__ + +# Check compile time warning +use warnings FATAL => 'syntax' ; +{ + no warnings ; + $a =+ 1 ; +} +$a =+ 1 ; +print STDERR "The End.\n" ; +EXPECT +Reversed += operator at - line 8. +######## + +# Check compile time warning +use warnings FATAL => 'all' ; +{ + no warnings ; + my $a =+ 1 ; +} +my $a =+ 1 ; +print STDERR "The End.\n" ; +EXPECT +Reversed += operator at - line 8. +######## + +# Check runtime scope of pragma +use warnings FATAL => 'uninitialized' ; +{ + no warnings ; + my $b ; chop $b ; +} +my $b ; chop $b ; +print STDERR "The End.\n" ; +EXPECT +Use of uninitialized value in scalar chop at - line 8. +######## + +# Check runtime scope of pragma +use warnings FATAL => 'all' ; +{ + no warnings ; + my $b ; chop $b ; +} +my $b ; chop $b ; +print STDERR "The End.\n" ; +EXPECT +Use of uninitialized value in scalar chop at - line 8. +######## + +# Check runtime scope of pragma +no warnings ; +{ + use warnings FATAL => 'uninitialized' ; + $a = sub { my $b ; chop $b ; } +} +&$a ; +print STDERR "The End.\n" ; +EXPECT +Use of uninitialized value in scalar chop at - line 6. +######## + +# Check runtime scope of pragma +no warnings ; +{ + use warnings FATAL => 'all' ; + $a = sub { my $b ; chop $b ; } +} +&$a ; +print STDERR "The End.\n" ; +EXPECT +Use of uninitialized value in scalar chop at - line 6. +######## + +--FILE-- abc +$a =+ 1 ; +1; +--FILE-- +use warnings FATAL => 'syntax' ; +require "./abc"; +EXPECT + +######## + +--FILE-- abc +use warnings FATAL => 'syntax' ; +1; +--FILE-- +require "./abc"; +$a =+ 1 ; +EXPECT + +######## + +--FILE-- abc +use warnings 'syntax' ; +$a =+ 1 ; +1; +--FILE-- +use warnings FATAL => 'uninitialized' ; +require "./abc"; +my $a ; chop $a ; +print STDERR "The End.\n" ; +EXPECT +Reversed += operator at ./abc line 2. +Use of uninitialized value in scalar chop at - line 3. +######## + +--FILE-- abc.pm +use warnings 'syntax' ; +$a =+ 1 ; +1; +--FILE-- +use warnings FATAL => 'uninitialized' ; +use abc; +my $a ; chop $a ; +print STDERR "The End.\n" ; +EXPECT +Reversed += operator at abc.pm line 2. +Use of uninitialized value in scalar chop at - line 3. +######## + +# Check scope of pragma with eval +no warnings ; +eval { + use warnings FATAL => 'uninitialized' ; + my $b ; chop $b ; +}; print STDERR "-- $@" ; +my $b ; chop $b ; +print STDERR "The End.\n" ; +EXPECT +-- Use of uninitialized value in scalar chop at - line 6. +The End. +######## + +# Check scope of pragma with eval +use warnings FATAL => 'uninitialized' ; +eval { + my $b ; chop $b ; +}; print STDERR "-- $@" ; +my $b ; chop $b ; +print STDERR "The End.\n" ; +EXPECT +-- Use of uninitialized value in scalar chop at - line 5. +Use of uninitialized value in scalar chop at - line 7. +######## + +# Check scope of pragma with eval +use warnings FATAL => 'uninitialized' ; +eval { + no warnings ; + my $b ; chop $b ; +}; print STDERR $@ ; +my $b ; chop $b ; +print STDERR "The End.\n" ; +EXPECT +Use of uninitialized value in scalar chop at - line 8. +######## + +# Check scope of pragma with eval +no warnings ; +eval { + use warnings FATAL => 'syntax' ; + $a =+ 1 ; +}; print STDERR "-- $@" ; +$a =+ 1 ; +print STDERR "The End.\n" ; +EXPECT +Reversed += operator at - line 6. +######## + +# Check scope of pragma with eval +use warnings FATAL => 'syntax' ; +eval { + $a =+ 1 ; +}; print STDERR "-- $@" ; +$a =+ 1 ; +print STDERR "The End.\n" ; +EXPECT +Reversed += operator at - line 5. +######## + +# Check scope of pragma with eval +use warnings FATAL => 'syntax' ; +eval { + no warnings ; + $a =+ 1 ; +}; print STDERR $@ ; +$a =+ 1 ; +print STDERR "The End.\n" ; +EXPECT +Reversed += operator at - line 8. +######## + +# Check scope of pragma with eval +no warnings ; +eval { + use warnings FATAL => 'syntax' ; +}; print STDERR $@ ; +$a =+ 1 ; +print STDERR "The End.\n" ; +EXPECT +The End. +######## + +# Check scope of pragma with eval +no warnings ; +eval q[ + use warnings FATAL => 'uninitialized' ; + my $b ; chop $b ; +]; print STDERR "-- $@"; +my $b ; chop $b ; +print STDERR "The End.\n" ; +EXPECT +-- Use of uninitialized value in scalar chop at (eval 1) line 3. +The End. +######## + +# Check scope of pragma with eval +use warnings FATAL => 'uninitialized' ; +eval ' + my $b ; chop $b ; +'; print STDERR "-- $@" ; +my $b ; chop $b ; +print STDERR "The End.\n" ; +EXPECT +-- Use of uninitialized value in scalar chop at (eval 1) line 2. +Use of uninitialized value in scalar chop at - line 7. +######## + +# Check scope of pragma with eval +use warnings FATAL => 'uninitialized' ; +eval ' + no warnings ; + my $b ; chop $b ; +'; print STDERR $@ ; +my $b ; chop $b ; +print STDERR "The End.\n" ; +EXPECT +Use of uninitialized value in scalar chop at - line 8. +######## + +# Check scope of pragma with eval +no warnings ; +eval q[ + use warnings FATAL => 'syntax' ; + $a =+ 1 ; +]; print STDERR "-- $@"; +$a =+ 1 ; +print STDERR "The End.\n" ; +EXPECT +-- Reversed += operator at (eval 1) line 3. +The End. +######## + +# Check scope of pragma with eval +use warnings FATAL => 'syntax' ; +eval ' + $a =+ 1 ; +'; print STDERR "-- $@"; +print STDERR "The End.\n" ; +EXPECT +-- Reversed += operator at (eval 1) line 2. +The End. +######## + +# Check scope of pragma with eval +use warnings FATAL => 'syntax' ; +eval ' + no warnings ; + $a =+ 1 ; +'; print STDERR "-- $@"; +$a =+ 1 ; +print STDERR "The End.\n" ; +EXPECT +Reversed += operator at - line 8. +######## + +use warnings 'void' ; + +time ; + +{ + use warnings FATAL => qw(void) ; + length "abc" ; +} + +join "", 1,2,3 ; + +print "done\n" ; +EXPECT +Useless use of time in void context at - line 4. +Useless use of length in void context at - line 8. +######## + +use warnings ; + +time ; + +{ + use warnings FATAL => qw(void) ; + length "abc" ; +} + +join "", 1,2,3 ; + +print "done\n" ; +EXPECT +Useless use of time in void context at - line 4. +Useless use of length in void context at - line 8. +######## + +use warnings FATAL => 'all'; +{ + no warnings; + my $b ; chop $b; + { + use warnings ; + my $b ; chop $b; + } +} +my $b ; chop $b; +print STDERR "The End.\n" ; +EXPECT +Use of uninitialized value in scalar chop at - line 8. +Use of uninitialized value in scalar chop at - line 11. +######## + +use warnings FATAL => 'all'; +{ + no warnings FATAL => 'all'; + my $b ; chop $b; + { + use warnings ; + my $b ; chop $b; + } +} +my $b ; chop $b; +print STDERR "The End.\n" ; +EXPECT +Use of uninitialized value in scalar chop at - line 8. +Use of uninitialized value in scalar chop at - line 11. +######## + +use warnings FATAL => 'all'; +{ + no warnings 'syntax'; + { + use warnings ; + my $b ; chop $b; + } +} +my $b ; chop $b; +print STDERR "The End.\n" ; +EXPECT +Use of uninitialized value in scalar chop at - line 7. +######## + +use warnings FATAL => 'syntax', NONFATAL => 'void' ; + +length "abc"; +print STDERR "The End.\n" ; +EXPECT +Useless use of length in void context at - line 4. +The End. +######## + +use warnings FATAL => 'all', NONFATAL => 'void' ; + +length "abc"; +print STDERR "The End.\n" ; +EXPECT +Useless use of length in void context at - line 4. +The End. +######## + +use warnings FATAL => 'all', NONFATAL => 'void' ; + +my $a ; chomp $a; +length "abc"; +print STDERR "The End.\n" ; +EXPECT +Useless use of length in void context at - line 5. +Use of uninitialized value in scalar chomp at - line 4. +######## + +use warnings FATAL => 'void', NONFATAL => 'void' ; + +length "abc"; +print STDERR "The End.\n" ; +EXPECT +Useless use of length in void context at - line 4. +The End. +######## + +use warnings NONFATAL => 'void', FATAL => 'void' ; + +length "abc"; +print STDERR "The End.\n" ; +EXPECT +Useless use of length in void context at - line 4. +######## + +use warnings FATAL => 'all', NONFATAL => 'io'; +no warnings 'once'; + +open(F, "<true\ncd"); +close "fred" ; +print STDERR "The End.\n" ; +EXPECT +Unsuccessful open on filename containing newline at - line 5. +close() on unopened filehandle fred at - line 6. +The End. +######## + +use warnings FATAL => 'all', NONFATAL => 'io', FATAL => 'unopened' ; +no warnings 'once'; + +open(F, "<true\ncd"); +close "fred" ; +print STDERR "The End.\n" ; +EXPECT +Unsuccessful open on filename containing newline at - line 5. +close() on unopened filehandle fred at - line 6. diff --git a/gnu/usr.bin/perl/t/lib/warnings/8signal b/gnu/usr.bin/perl/t/lib/warnings/8signal new file mode 100644 index 00000000000..cc1b9d926d7 --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/warnings/8signal @@ -0,0 +1,18 @@ +Check interaction of __WARN__, __DIE__ & lexical Warnings + +TODO + +__END__ +# 8signal +BEGIN { $| = 1; $SIG{__WARN__} = sub { print "WARN -- @_" } } +BEGIN { $SIG{__DIE__} = sub { print "DIE -- @_" } } +$a =+ 1 ; +use warnings qw(syntax) ; +$a =+ 1 ; +use warnings FATAL => qw(syntax) ; +$a =+ 1 ; +print "The End.\n" ; +EXPECT +WARN -- Reversed += operator at - line 6. +DIE -- Reversed += operator at - line 8. +Reversed += operator at - line 8. diff --git a/gnu/usr.bin/perl/t/lib/warnings/9enabled b/gnu/usr.bin/perl/t/lib/warnings/9enabled new file mode 100644 index 00000000000..99d32e54e81 --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/warnings/9enabled @@ -0,0 +1,1181 @@ +Check warnings::enabled & warnings::warn + +__END__ + +--FILE-- abc.pm +package abc ; +use warnings "io" ; +print "ok1\n" if ! warnings::enabled('all') ; +print "ok2\n" if ! warnings::enabled("io") ; +1; +--FILE-- +no warnings; +use abc ; +EXPECT +ok1 +ok2 +######## + +--FILE-- abc.pm +package abc ; +no warnings ; +print "ok1\n" if !warnings::enabled('all') ; +print "ok2\n" if warnings::enabled("syntax") ; +1; +--FILE-- +use warnings 'syntax' ; +use abc ; +EXPECT +ok1 +ok2 +######## + +--FILE-- abc.pm +package abc ; +use warnings 'syntax' ; +print "ok1\n" if warnings::enabled('io') ; +print "ok2\n" if ! warnings::enabled("syntax") ; +1; +--FILE-- +use warnings 'io' ; +use abc ; +EXPECT +ok1 +ok2 +######## + +--FILE-- abc +no warnings ; +print "ok1\n" if !warnings::enabled('all') ; +print "ok2\n" if warnings::enabled("syntax") ; +1; +--FILE-- +use warnings 'syntax' ; +require "abc" ; +EXPECT +ok1 +ok2 +######## + +--FILE-- abc +use warnings 'syntax' ; +print "ok1\n" if ! warnings::enabled('all') ; +print "ok2\n" if ! warnings::enabled("syntax") ; +print "ok3\n" if warnings::enabled("io") ; +1; +--FILE-- +use warnings 'io' ; +require "abc" ; +EXPECT +ok1 +ok2 +ok3 +######## + +--FILE-- abc.pm +package abc ; +no warnings ; +sub check { + print "ok1\n" if !warnings::enabled('all') ; + print "ok2\n" if warnings::enabled("syntax") ; +} +1; +--FILE-- +use warnings 'syntax' ; +use abc ; +abc::check() ; +EXPECT +ok1 +ok2 +######## + +--FILE-- abc.pm +package abc ; +use warnings 'io' ; +sub check { + print "ok1\n" if ! warnings::enabled('all') ; + print "ok2\n" if warnings::enabled("syntax") ; + print "ok3\n" if ! warnings::enabled("io") ; +} +1; +--FILE-- +use warnings 'syntax' ; +use abc ; +abc::check() ; +EXPECT +ok1 +ok2 +ok3 +######## + +--FILE-- abc +package abc ; +no warnings ; +sub check { + print "ok1\n" if !warnings::enabled('all') ; + print "ok2\n" if warnings::enabled("syntax") ; +} +1; +--FILE-- +use warnings 'syntax' ; +require "abc" ; +abc::check() ; +EXPECT +ok1 +ok2 +######## + +--FILE-- abc +package abc ; +use warnings 'io' ; +sub check { + print "ok1\n" if ! warnings::enabled('all') ; + print "ok2\n" if warnings::enabled("syntax") ; + print "ok3\n" if ! warnings::enabled("io") ; +} +1; +--FILE-- +use warnings 'syntax' ; +require "abc" ; +abc::check() ; +EXPECT +ok1 +ok2 +ok3 +######## + +--FILE-- abc.pm +package abc ; +use warnings "io" ; +print "ok1\n" if ! warnings::enabled('all') ; +print "ok2\n" if ! warnings::enabled("io") ; +1; +--FILE-- def.pm +package def; +no warnings; +use abc ; +1; +--FILE-- +use warnings; +use def ; +EXPECT +ok1 +ok2 +######## + +--FILE-- abc.pm +package abc ; +no warnings ; +print "ok1\n" if ! warnings::enabled('all') ; +print "ok2\n" if warnings::enabled("syntax") ; +print "ok3\n" if !warnings::enabled("io") ; +1; +--FILE-- def.pm +use warnings 'syntax' ; +print "ok4\n" if !warnings::enabled('all') ; +print "ok5\n" if warnings::enabled("io") ; +use abc ; +1; +--FILE-- +use warnings 'io' ; +use def ; +EXPECT +ok1 +ok2 +ok3 +ok4 +ok5 +######## + +--FILE-- abc.pm +package abc ; +no warnings ; +sub check { + print "ok1\n" if !warnings::enabled('all') ; + print "ok2\n" if warnings::enabled("syntax") ; +} +1; +--FILE-- +use warnings 'syntax' ; +use abc ; +eval { + abc::check() ; +}; +print $@ ; +EXPECT +ok1 +ok2 +######## + +--FILE-- abc.pm +package abc ; +use warnings 'io' ; +sub check { + print "ok1\n" if ! warnings::enabled('all') ; + print "ok2\n" if warnings::enabled("syntax") ; + print "ok3\n" if ! warnings::enabled("io") ; +} +1; +--FILE-- +use warnings 'syntax' ; +use abc ; +eval { + abc::check() ; + } ; +print $@ ; +EXPECT +ok1 +ok2 +ok3 +######## + +--FILE-- abc +package abc ; +no warnings ; +sub check { + print "ok1\n" if !warnings::enabled('all') ; + print "ok2\n" if warnings::enabled("syntax") ; +} +1; +--FILE-- +use warnings 'syntax' ; +require "abc" ; +eval { + abc::check() ; + } ; +print $@ ; +EXPECT +ok1 +ok2 +######## + +--FILE-- abc +package abc ; +use warnings 'io' ; +sub check { + print "ok1\n" if !warnings::enabled('all') ; + print "ok2\n" if warnings::enabled("syntax") ; + print "ok3\n" if warnings::enabled("io") ; +} +1; +--FILE-- +use warnings 'syntax' ; +require "abc" ; +eval { + use warnings 'io' ; + abc::check() ; +}; +abc::check() ; +print $@ ; +EXPECT +ok1 +ok2 +ok3 +ok1 +ok2 +######## + +--FILE-- abc.pm +package abc ; +use warnings 'io' ; +sub check { + print "ok1\n" if ! warnings::enabled('all') ; + print "ok2\n" if warnings::enabled("syntax") ; + print "ok3\n" if ! warnings::enabled("io") ; +} +1; +--FILE-- +use warnings 'syntax' ; +use abc ; +sub fred { abc::check() } +fred() ; +EXPECT +ok1 +ok2 +ok3 +######## + +--FILE-- abc.pm +package abc ; +use warnings 'io' ; +sub check { + print "ok1\n" if ! warnings::enabled('all') ; +} +1; +--FILE-- +use warnings 'syntax' ; +use abc ; +sub fred { no warnings ; abc::check() } +fred() ; +EXPECT +ok1 +######## + +--FILE-- abc.pm +package abc ; +use warnings 'misc' ; +sub check { + print "ok1\n" if ! warnings::enabled('all') ; + print "ok2\n" if warnings::enabled("syntax") ; + print "ok3\n" if warnings::enabled("io") ; + print "ok4\n" if ! warnings::enabled("misc") ; +} +1; +--FILE-- +use warnings 'syntax' ; +use abc ; +sub fred { use warnings 'io' ; abc::check() } +fred() ; +EXPECT +ok1 +ok2 +ok3 +ok4 +######## + +# check warnings::warn +use warnings ; +eval { + warnings::warn() + } ; +print $@ ; +eval { + warnings::warn("fred", "joe") + } ; +print $@ ; +EXPECT +Usage: warnings::warn([category,] 'message') at - line 5 +Unknown warnings category 'fred' at - line 9 +######## + +# check warnings::warnif +use warnings ; +eval { + warnings::warnif() +} ; +print $@ ; +eval { + warnings::warnif("fred", "joe") +} ; +print $@ ; +EXPECT +Usage: warnings::warnif([category,] 'message') at - line 5 +Unknown warnings category 'fred' at - line 9 +######## + +--FILE-- abc.pm +package abc ; +use warnings 'misc' ; +sub check { warnings::warn("io", "hello") } +1; +--FILE-- +use warnings "io" ; +use abc; +abc::check() ; +EXPECT +hello at - line 3 +######## + +--FILE-- abc.pm +package abc ; +use warnings 'misc' ; +sub check { warnings::warn("misc", "hello") } +1; +--FILE-- +use warnings "io" ; +use abc; +abc::check() ; +EXPECT +hello at - line 3 +######## + +--FILE-- abc.pm +package abc ; +use warnings 'misc' ; +sub check { warnings::warn("io", "hello") } +1; +--FILE-- +use warnings qw( FATAL deprecated ) ; +use abc; +eval { + abc::check() ; + } ; +print "[[$@]]\n"; +EXPECT +hello at - line 4 +[[]] +######## + +--FILE-- abc.pm +package abc ; +use warnings 'misc' ; +sub check { warnings::warn("io", "hello") } +1; +--FILE-- +use warnings qw( FATAL io ) ; +use abc; +eval { + abc::check() ; +} ; +print "[[$@]]\n"; +EXPECT +[[hello at - line 4 +]] +######## +-W +--FILE-- abc.pm +package abc ; +use warnings "io" ; +print "ok1\n" if warnings::enabled("io") ; +print "ok2\n" if warnings::enabled("all") ; +1; +--FILE-- +no warnings; +use abc ; +EXPECT +ok1 +ok2 +######## +-X +--FILE-- abc.pm +package abc ; +use warnings "io" ; +print "ok1\n" if !warnings::enabled("io") ; +print "ok2\n" if !warnings::enabled("all") ; +1; +--FILE-- +use warnings; +use abc ; +EXPECT +ok1 +ok2 +######## + +--FILE-- abc.pm +package abc ; +no warnings ; +sub check { + print "ok\n" if ! warnings::enabled() ; +} +1; +--FILE-- +use warnings 'syntax' ; +use abc ; +abc::check() ; +EXPECT +package 'abc' not registered for warnings at abc.pm line 4 +######## + +--FILE-- abc.pm +package abc ; +no warnings ; +sub check { + warnings::warn("fred") ; +} +1; +--FILE-- +use warnings 'syntax' ; +use abc ; +abc::check() ; +EXPECT +package 'abc' not registered for warnings at abc.pm line 4 +######## + +--FILE-- abc.pm +package abc ; +no warnings ; +sub check { + warnings::warnif("fred") ; +} +1; +--FILE-- +use warnings 'syntax' ; +use abc ; +abc::check() ; +EXPECT +package 'abc' not registered for warnings at abc.pm line 4 +######## + +--FILE-- abc.pm +package abc ; +use warnings 'io' ; +use warnings::register ; +sub check { + print "ok1\n" if warnings::enabled ; + print "ok2\n" if warnings::enabled("syntax") ; + print "ok3\n" if !warnings::enabled("io") ; +} +1; +--FILE-- +use warnings 'syntax' ; +use abc ; +use warnings 'abc' ; +abc::check() ; +EXPECT +ok1 +ok2 +ok3 +######## + +--FILE-- abc.pm +package abc ; +use warnings 'io' ; +use warnings::register ; +sub check { + print "ok1\n" if !warnings::enabled ; + print "ok2\n" if warnings::enabled("syntax") ; + print "ok3\n" if !warnings::enabled("io") ; +} +1; +--FILE-- +use warnings 'syntax' ; +use abc ; +abc::check() ; +EXPECT +ok1 +ok2 +ok3 +######## + +--FILE-- abc.pm +package abc ; +no warnings ; +use warnings::register ; +sub check { + print "ok1\n" if warnings::enabled ; + print "ok2\n" if warnings::enabled("syntax") ; +} +1; +--FILE-- +use warnings 'syntax' ; +use abc ; +use warnings 'abc' ; +eval { abc::check() ; }; +print $@ ; +EXPECT +ok1 +ok2 +######## + +--FILE-- abc.pm +package abc ; +use warnings 'io' ; +use warnings::register ; +sub check { + print "ok1\n" if !warnings::enabled ; + print "ok2\n" if warnings::enabled("syntax") ; + print "ok3\n" if !warnings::enabled("io") ; +} +1; +--FILE-- +use warnings 'syntax' ; +use abc ; +eval { abc::check() ; } ; +print $@ ; +EXPECT +ok1 +ok2 +ok3 +######## + +--FILE-- abc.pm +package abc ; +use warnings 'io' ; +use warnings::register ; +sub check { + print "ok1\n" if warnings::enabled ; + print "ok2\n" if warnings::enabled("syntax") ; + print "ok3\n" if !warnings::enabled("io") ; +} +1; +--FILE-- +use warnings 'syntax' ; +use abc ; +use warnings 'abc' ; +sub fred { abc::check() } +fred() ; +EXPECT +ok1 +ok2 +ok3 +######## + +--FILE-- abc.pm +package abc ; +use warnings 'io' ; +use warnings::register ; +sub check { + print "ok1\n" if ! warnings::enabled ; +} +1; +--FILE-- +use warnings 'syntax' ; +use abc ; +sub fred { no warnings ; abc::check() } +fred() ; +EXPECT +ok1 +######## + +--FILE-- abc.pm +package abc ; +use warnings 'misc' ; +use warnings::register; +sub check { + print "ok1\n" if warnings::enabled ; + print "ok2\n" if warnings::enabled("syntax") ; + print "ok3\n" if warnings::enabled("io") ; + print "ok4\n" if ! warnings::enabled("misc") ; +} +1; +--FILE-- +use warnings 'syntax' ; +use abc ; +use warnings 'abc' ; +sub fred { use warnings 'io' ; abc::check() } +fred() ; +EXPECT +ok1 +ok2 +ok3 +ok4 +######## + +--FILE-- abc.pm +package abc ; +use warnings 'misc' ; +use warnings::register; +sub check { warnings::warn("hello") } +1; +--FILE-- +use abc; +use warnings "abc" ; +abc::check() ; +EXPECT +hello at - line 3 +######## + +--FILE-- abc.pm +package abc ; +use warnings::register; +sub check { warnings::warn("hello") } +1; +--FILE-- +use abc; +abc::check() ; +EXPECT +hello at - line 2 +######## + +--FILE-- abc.pm +package abc ; +use warnings::register ; +sub check { warnings::warn("hello") } +1; +--FILE-- +use abc; +use warnings qw( FATAL deprecated ) ; +eval { + abc::check() ; + } ; +print "[[$@]]\n"; +EXPECT +hello at - line 4 +[[]] +######## + +--FILE-- abc.pm +package abc ; +use warnings::register ; +sub check { warnings::warn("hello") } +1; +--FILE-- +use abc; +use warnings qw( FATAL abc ) ; +eval { + abc::check() ; + } ; +print "[[$@]]\n"; +EXPECT +[[hello at - line 4 +]] +######## +-W +--FILE-- abc.pm +package abc ; +use warnings "io" ; +use warnings::register ; +sub check { + print "ok1\n" if warnings::enabled() ; + print "ok2\n" if warnings::enabled("io") ; + print "ok3\n" if warnings::enabled("all") ; +} +1; +--FILE-- +no warnings; +use abc ; +abc::check() ; +EXPECT +ok1 +ok2 +ok3 +######## +-X +--FILE-- abc.pm +package abc ; +use warnings "io" ; +use warnings::register ; +sub check { + print "ok1\n" if !warnings::enabled() ; + print "ok2\n" if !warnings::enabled("io") ; + print "ok3\n" if !warnings::enabled("all") ; +} +1; +--FILE-- +no warnings; +use abc ; +abc::check() ; +EXPECT +ok1 +ok2 +ok3 +######## + +--FILE-- abc.pm +package abc ; +use warnings "io" ; +use warnings::register ; +sub check { + print "ok1\n" if warnings::enabled() ; + print "ok2\n" if warnings::enabled("io") ; + print "ok3\n" if warnings::enabled("all") ; +} +1; +--FILE-- +use warnings 'all'; +use abc ; +abc::check() ; +EXPECT +ok1 +ok2 +ok3 +######## + +--FILE-- abc.pm +package abc ; +use warnings "io" ; +use warnings::register ; +sub check { + print "ok1\n" if !warnings::enabled() ; + print "ok2\n" if !warnings::enabled("io") ; + print "ok3\n" if !warnings::enabled("all") ; +} +1; +--FILE-- +use abc ; +no warnings ; +abc::check() ; +EXPECT +ok1 +ok2 +ok3 +######## + +--FILE-- abc.pm +package abc ; +use warnings "io" ; +use warnings::register ; +sub check { + print "ok1\n" if !warnings::enabled() ; + print "ok2\n" if !warnings::enabled("io") ; + print "ok3\n" if !warnings::enabled("all") ; + warnings::warnif("my message 1") ; + warnings::warnif('abc', "my message 2") ; + warnings::warnif('io', "my message 3") ; + warnings::warnif('all', "my message 4") ; +} +1; +--FILE-- +use abc ; +use warnings 'abc'; +no warnings ; +abc::check() ; +EXPECT +ok1 +ok2 +ok3 +######## + +--FILE-- abc.pm +package abc ; +use warnings "io" ; +use warnings::register ; +sub check { + print "abc self" . (warnings::enabled() ? "" : " not") . " enabled\n" ; + print "abc def" . (warnings::enabled('def') ? "" : " not") . " enabled\n" ; + print "abc all" . (warnings::enabled('all') ? "" : " not") . " enabled\n" ; +} +1; +--FILE-- def.pm +package def ; +use warnings "io" ; +use warnings::register ; +sub check { + print "def self" . (warnings::enabled() ? "" : " not") . " enabled\n" ; + print "def abc" . (warnings::enabled('abc') ? "" : " not") . " enabled\n" ; + print "def all" . (warnings::enabled('all') ? "" : " not") . " enabled\n" ; +} +1; +--FILE-- +use abc ; +use def ; +use warnings 'abc'; +abc::check() ; +def::check() ; +no warnings 'abc' ; +use warnings 'def' ; +abc::check() ; +def::check() ; +use warnings 'abc' ; +use warnings 'def' ; +abc::check() ; +def::check() ; +no warnings 'abc' ; +no warnings 'def' ; +abc::check() ; +def::check() ; +use warnings; +abc::check() ; +def::check() ; +no warnings 'abc' ; +abc::check() ; +def::check() ; +EXPECT +abc self enabled +abc def not enabled +abc all not enabled +def self not enabled +def abc enabled +def all not enabled +abc self not enabled +abc def enabled +abc all not enabled +def self enabled +def abc not enabled +def all not enabled +abc self enabled +abc def enabled +abc all not enabled +def self enabled +def abc enabled +def all not enabled +abc self not enabled +abc def not enabled +abc all not enabled +def self not enabled +def abc not enabled +def all not enabled +abc self enabled +abc def enabled +abc all enabled +def self enabled +def abc enabled +def all enabled +abc self not enabled +abc def enabled +abc all not enabled +def self enabled +def abc not enabled +def all not enabled +######## +-w +--FILE-- abc.pm +package abc ; +no warnings ; +use warnings::register ; +sub check { + print "ok1\n" if warnings::enabled() ; + print "ok2\n" if warnings::enabled("io") ; + print "ok3\n" if warnings::enabled("all") ; +} +1; +--FILE-- +use abc ; +abc::check() ; +EXPECT +ok1 +ok2 +ok3 +######## +-w +--FILE-- abc.pm +package abc ; +no warnings ; +use warnings::register ; +sub check { + print "ok1\n" if !warnings::enabled() ; + print "ok2\n" if !warnings::enabled("io") ; + print "ok3\n" if !warnings::enabled("all") ; +} +1; +--FILE-- +use abc ; +use warnings 'abc'; +no warnings ; +abc::check() ; +EXPECT +ok1 +ok2 +ok3 +######## + +--FILE-- abc.pm +package abc ; +no warnings ; +use warnings::register ; +sub check { + print "ok1\n" if !warnings::enabled() ; + print "ok2\n" if !warnings::enabled("io") ; + print "ok3\n" if !warnings::enabled("all") ; + warnings::warnif("my message 1") ; + warnings::warnif('abc', "my message 2") ; + warnings::warnif('io', "my message 3") ; + warnings::warnif('all', "my message 4") ; +} +1; +--FILE-- +use abc ; +use warnings 'abc'; +no warnings ; +BEGIN { $^W = 1 ; } +abc::check() ; +EXPECT +ok1 +ok2 +ok3 +######## + +--FILE-- abc.pm +package abc ; +no warnings ; +use warnings::register ; +sub check { + print "ok1\n" if !warnings::enabled() ; + print "ok2\n" if !warnings::enabled("io") ; + print "ok3\n" if !warnings::enabled("all") ; +} +1; +--FILE-- +use abc ; +use warnings 'abc'; +no warnings ; +$^W = 1 ; +abc::check() ; +EXPECT +ok1 +ok2 +ok3 +######## + +--FILE-- abc.pm +$| = 1; +package abc ; +no warnings ; +use warnings::register ; +sub check { + print "ok1\n" if warnings::enabled() ; + print "ok2\n" if !warnings::enabled("io") ; + print "ok3\n" if !warnings::enabled("all") ; + print "ok4\n" if warnings::enabled("abc") ; + warnings::warn("my message 1") ; + warnings::warnif("my message 2") ; + warnings::warnif('abc', "my message 3") ; + warnings::warnif('io', "my message 4") ; + warnings::warnif('all', "my message 5") ; +} +sub in2 { no warnings ; check() } +sub in1 { no warnings ; in2() } +1; +--FILE-- +use abc ; +use warnings 'abc'; +abc::in1() ; +EXPECT +ok1 +ok2 +ok3 +ok4 +my message 1 at - line 3 +my message 2 at - line 3 +my message 3 at - line 3 +######## + +--FILE-- def.pm +package def ; +no warnings ; +use warnings::register ; +sub check { + print "ok1\n" if warnings::enabled() ; + print "ok2\n" if !warnings::enabled("io") ; + print "ok3\n" if !warnings::enabled("all") ; + print "ok4\n" if warnings::enabled("def") ; + warnings::warn("my message 1") ; + warnings::warnif("my message 2") ; + warnings::warnif('def', "my message 3") ; + warnings::warnif('io', "my message 4") ; + warnings::warnif('all', "my message 5") ; +} +sub in2 { no warnings ; check() } +sub in1 { no warnings ; in2() } +1; +--FILE-- abc.pm +$| = 1; +package abc ; +use def ; +use warnings 'def'; +sub in1 { def::in1() ; } +1; +--FILE-- +use abc ; +no warnings; +abc::in1() ; +EXPECT +ok1 +ok2 +ok3 +ok4 +my message 1 at abc.pm line 5 +my message 2 at abc.pm line 5 +my message 3 at abc.pm line 5 +######## + +--FILE-- def.pm +$| = 1; +package def ; +no warnings ; +use warnings::register ; +require Exporter; +@ISA = qw( Exporter ) ; +@EXPORT = qw( in1 ) ; +sub check { + print "ok1\n" if warnings::enabled() ; + print "ok2\n" if !warnings::enabled("io") ; + print "ok3\n" if !warnings::enabled("all") ; + print "ok4\n" if warnings::enabled("abc") ; + print "ok5\n" if !warnings::enabled("def") ; + warnings::warn("my message 1") ; + warnings::warnif("my message 2") ; + warnings::warnif('abc', "my message 3") ; + warnings::warnif('def', "my message 4") ; + warnings::warnif('io', "my message 5") ; + warnings::warnif('all', "my message 6") ; +} +sub in2 { no warnings ; check() } +sub in1 { no warnings ; in2() } +1; +--FILE-- abc.pm +package abc ; +use warnings::register ; +use def ; +#@ISA = qw(def) ; +1; +--FILE-- +use abc ; +no warnings; +use warnings 'abc'; +abc::in1() ; +EXPECT +ok2 +ok3 +ok4 +ok5 +my message 1 at - line 4 +my message 3 at - line 4 +######## + +--FILE-- def.pm +package def ; +no warnings ; +use warnings::register ; + +sub new +{ + my $class = shift ; + bless [], $class ; +} + +sub check +{ + my $self = shift ; + print "ok1\n" if !warnings::enabled() ; + print "ok2\n" if !warnings::enabled("io") ; + print "ok3\n" if !warnings::enabled("all") ; + print "ok4\n" if warnings::enabled("abc") ; + print "ok5\n" if !warnings::enabled("def") ; + print "ok6\n" if warnings::enabled($self) ; + + warnings::warn("my message 1") ; + warnings::warn($self, "my message 2") ; + + warnings::warnif("my message 3") ; + warnings::warnif('abc', "my message 4") ; + warnings::warnif('def', "my message 5") ; + warnings::warnif('io', "my message 6") ; + warnings::warnif('all', "my message 7") ; + warnings::warnif($self, "my message 8") ; +} +sub in2 +{ + no warnings ; + my $self = shift ; + $self->check() ; +} +sub in1 +{ + no warnings ; + my $self = shift ; + $self->in2(); +} +1; +--FILE-- abc.pm +$| = 1; +package abc ; +use warnings::register ; +use def ; +@ISA = qw(def) ; +sub new +{ + my $class = shift ; + bless [], $class ; +} + +1; +--FILE-- +use abc ; +no warnings; +use warnings 'abc'; +$a = new abc ; +$a->in1() ; +print "**\n"; +$b = new def ; +$b->in1() ; +EXPECT +ok1 +ok2 +ok3 +ok4 +ok5 +ok6 +my message 1 at - line 5 +my message 2 at - line 5 +my message 4 at - line 5 +my message 8 at - line 5 +** +ok1 +ok2 +ok3 +ok4 +ok5 +my message 1 at - line 8 +my message 2 at - line 8 +my message 4 at - line 8 diff --git a/gnu/usr.bin/perl/t/lib/warnings/av b/gnu/usr.bin/perl/t/lib/warnings/av new file mode 100644 index 00000000000..79bd3b7600f --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/warnings/av @@ -0,0 +1,9 @@ + av.c + + Mandatory Warnings ALL TODO + ------------------ + av_reify called on tied array [av_reify] + + Attempt to clear deleted array [av_clear] + +__END__ diff --git a/gnu/usr.bin/perl/t/lib/warnings/doio b/gnu/usr.bin/perl/t/lib/warnings/doio new file mode 100644 index 00000000000..bb09aa85520 --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/warnings/doio @@ -0,0 +1,277 @@ + doio.c + + Can't open bidirectional pipe [Perl_do_open9] + open(F, "| true |"); + + Missing command in piped open [Perl_do_open9] + open(F, "| "); + + Missing command in piped open [Perl_do_open9] + open(F, " |"); + + warn(warn_nl, "open"); [Perl_do_open9] + open(F, "true\ncd") + + close() on unopened filehandle %s [Perl_do_close] + $a = "fred";close("$a") + + tell() on closed filehandle [Perl_do_tell] + $a = "fred";$a = tell($a) + + seek() on closed filehandle [Perl_do_seek] + $a = "fred";$a = seek($a,1,1) + + sysseek() on closed filehandle [Perl_do_sysseek] + $a = "fred";$a = seek($a,1,1) + + warn(warn_uninit); [Perl_do_print] + print $a ; + + -x on closed filehandle %s [Perl_my_stat] + close STDIN ; -x STDIN ; + + warn(warn_nl, "stat"); [Perl_my_stat] + stat "ab\ncd" + + warn(warn_nl, "lstat"); [Perl_my_lstat] + lstat "ab\ncd" + + Use of -l on filehandle %s [Perl_my_lstat] + + Can't exec \"%s\": %s [Perl_do_aexec5] + + 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 + ------------------ + Can't do inplace edit: %s is not a regular file [Perl_nextargv] + edit a directory + + 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__ +# doio.c [Perl_do_open9] +use warnings 'io' ; +open(F, '|'.($^O eq 'VMS' ? 'mcr ':'')."$^X -e 1|"); +close(F); +no warnings 'io' ; +open(G, '|'.($^O eq 'VMS' ? 'mcr ':'')."$^X -e 1|"); +close(G); +EXPECT +Can't open bidirectional pipe at - line 3. +######## +# doio.c [Perl_do_open9] +use warnings 'io' ; +open(F, "| "); +no warnings 'io' ; +open(G, "| "); +EXPECT +Missing command in piped open at - line 3. +######## +# doio.c [Perl_do_open9] +use warnings 'io' ; +open(F, " |"); +no warnings 'io' ; +open(G, " |"); +EXPECT +Missing command in piped open at - line 3. +######## +# doio.c [Perl_do_open9] +use warnings 'io' ; +open(F, "<true\ncd"); +no warnings 'io' ; +open(G, "<true\ncd"); +EXPECT +Unsuccessful open on filename containing newline at - line 3. +######## +# doio.c [Perl_do_close] <<TODO +use warnings 'unopened' ; +close "fred" ; +no warnings 'unopened' ; +close "joe" ; +EXPECT +close() on unopened filehandle 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); +$a = seek(STDIN,1,1); +$a = sysseek(STDIN,1,1); +-x STDIN ; +stat(STDIN) ; +$a = "fred"; +tell($a); +seek($a,1,1); +sysseek($a,1,1); +-x $a; # ok +stat($a); # ok +no warnings 'io' ; +close STDIN ; +tell(STDIN); +$a = seek(STDIN,1,1); +$a = sysseek(STDIN,1,1); +-x STDIN ; +stat(STDIN) ; +$a = "fred"; +tell($a); +seek($a,1,1); +sysseek($a,1,1); +-x $a; +stat($a); +EXPECT +tell() on closed filehandle STDIN at - line 4. +seek() on closed filehandle STDIN at - line 5. +sysseek() on closed filehandle STDIN at - line 6. +-x on closed filehandle STDIN at - line 7. +stat() on closed filehandle STDIN at - line 8. +tell() on unopened filehandle at - line 10. +seek() on unopened filehandle at - line 11. +sysseek() on unopened filehandle at - line 12. +######## +# doio.c [Perl_do_print] +use warnings 'uninitialized' ; +print $a ; +no warnings 'uninitialized' ; +print $b ; +EXPECT +Use of uninitialized value in print at - line 3. +######## +# doio.c [Perl_my_stat Perl_my_lstat] +use warnings 'io' ; +stat "ab\ncd"; +lstat "ab\ncd"; +no warnings '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 [Perl_my_stat] +use warnings 'io'; +-l STDIN; +-l $fh; +open $fh, $0 or die "# $!"; +-l $fh; +no warnings 'io'; +-l STDIN; +-l $fh; +close $fh; +EXPECT +Use of -l on filehandle STDIN at - line 3. +Use of -l on filehandle $fh at - line 6. +######## +# doio.c [Perl_do_aexec5] +BEGIN { + if ($^O eq 'MacOS') { + print <<EOM; +SKIPPED +# no exec on Mac OS +EOM + exit; + } +} +use warnings 'io' ; +exec "lskdjfalksdjfdjfkls","" ; +no warnings 'io' ; +exec "lskdjfalksdjfdjfkls","" ; +EXPECT +OPTION regex +Can't exec "lskdjfalksdjfdjfkls": .+ +######## +# doio.c [Perl_do_exec3] +BEGIN { + if ($^O eq 'MacOS') { + print <<EOM; +SKIPPED +# no exec on Mac OS +EOM + exit; + } +} +use warnings 'io' ; +exec "lskdjfalksdjfdjfkls", "abc" ; +no warnings 'io' ; +exec "lskdjfalksdjfdjfkls", "abc" ; +EXPECT +OPTION regex +Can't exec "lskdjfalksdjfdjfkls(:? abc)?": .+ +######## +# doio.c [win32_execvp] +BEGIN { + if ($^O eq 'MacOS') { + print <<EOM; +SKIPPED +# no exec on Mac OS +EOM + exit; + } +} +use warnings 'exec' ; +exec $^X, "-e0" ; +EXPECT +######## +# doio.c [Perl_nextargv] +$^W = 0 ; +my $filename = "./temp.dir" ; +mkdir $filename, 0777 + or die "Cannot create directory $filename: $!\n" ; +{ + local (@ARGV) = ($filename) ; + local ($^I) = "" ; + my $x = <> ; +} +{ + no warnings 'inplace' ; + local (@ARGV) = ($filename) ; + local ($^I) = "" ; + my $x = <> ; +} +{ + use warnings 'inplace' ; + local (@ARGV) = ($filename) ; + local ($^I) = "" ; + my $x = <> ; +} +rmdir $filename ; +EXPECT +Can't do inplace edit: ./temp.dir is not a regular file at - line 9. +Can't do inplace edit: ./temp.dir 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 STDOUT opened only for output at - line 3. +######## +# doio.c [Perl_do_openn] +use Config; +BEGIN { + if ($Config{useperlio}) { + print <<EOM; +SKIPPED +# warns only without perlio +EOM + exit; + } +} +use warnings 'io'; +my $x = "foo"; +open FOO, '>', \$x; +open BAR, '>&', \*STDOUT; # should not warn +no warnings 'io'; +open FOO, '>', \$x; +EXPECT +Can't open a reference at - line 14. diff --git a/gnu/usr.bin/perl/t/lib/warnings/doop b/gnu/usr.bin/perl/t/lib/warnings/doop new file mode 100644 index 00000000000..5803b445812 --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/warnings/doop @@ -0,0 +1,6 @@ +# doop.c +use utf8 ; +$_ = "\x80 \xff" ; +chop ; +EXPECT +######## diff --git a/gnu/usr.bin/perl/t/lib/warnings/gv b/gnu/usr.bin/perl/t/lib/warnings/gv new file mode 100644 index 00000000000..5ed4eca0180 --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/warnings/gv @@ -0,0 +1,54 @@ + 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 = ${"*"} ; + + Mandatory Warnings ALL TODO + ------------------ + + Had to create %s unexpectedly [gv_fetchpv] + Attempt to free unreferenced glob pointers [gp_free] + +__END__ +# gv.c +use warnings '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 +no warnings 'misc' ; +@ISA = qw(Fred); joe() +EXPECT +Undefined subroutine &main::joe called at - line 3. +######## +# gv.c +sub Other::AUTOLOAD { 1 } sub Other::fred {} +@ISA = qw(Other) ; +use warnings 'deprecated' ; +fred() ; +EXPECT +Use of inherited AUTOLOAD for non-method main::fred() is deprecated at - line 5. +######## +# gv.c +use warnings 'deprecated' ; +$a = ${"#"}; +$a = ${"*"}; +no warnings 'deprecated' ; +$a = ${"#"}; +$a = ${"*"}; +EXPECT +Use of $# is deprecated at - line 3. +Use of $* is deprecated at - line 4. diff --git a/gnu/usr.bin/perl/t/lib/warnings/hv b/gnu/usr.bin/perl/t/lib/warnings/hv new file mode 100644 index 00000000000..c9eec028f14 --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/warnings/hv @@ -0,0 +1,8 @@ + hv.c + + + Mandatory Warnings ALL TODO + ------------------ + Attempt to free non-existent shared string [unsharepvn] + +__END__ diff --git a/gnu/usr.bin/perl/t/lib/warnings/malloc b/gnu/usr.bin/perl/t/lib/warnings/malloc new file mode 100644 index 00000000000..2f8b096a518 --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/warnings/malloc @@ -0,0 +1,9 @@ + malloc.c + + + Mandatory Warnings ALL TODO + ------------------ + %s free() ignored [Perl_mfree] + %s", "Bad free() ignored [Perl_mfree] + +__END__ diff --git a/gnu/usr.bin/perl/t/lib/warnings/mg b/gnu/usr.bin/perl/t/lib/warnings/mg new file mode 100644 index 00000000000..f7c3ebf435c --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/warnings/mg @@ -0,0 +1,57 @@ + mg.c AOK + + No such signal: SIG%s + $SIG{FRED} = sub {} + + SIG%s handler \"%s\" not defined. + $SIG{"INT"} = "ok3"; kill "INT",$$; + + Mandatory Warnings TODO + ------------------ + Can't break at that line [magic_setdbline] + +__END__ +# mg.c +use warnings 'signal' ; +$SIG{FRED} = sub {}; +EXPECT +No such signal: SIGFRED at - line 3. +######## +# mg.c +no warnings 'signal' ; +$SIG{FRED} = sub {}; +EXPECT + +######## +# mg.c +use warnings 'signal' ; +if ($^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'VMS' || $^O eq 'MacOS') { + print "SKIPPED\n# $^O, can't kill() to raise()\n"; exit; +} +$|=1; +$SIG{"INT"} = "fred"; kill "INT",$$; +EXPECT +SIGINT handler "fred" not defined. +######## +# mg.c +no warnings 'signal' ; +if ($^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'VMS' || $^O eq 'MacOS') { + print "SKIPPED\n# $^O, can't kill() to raise()\n"; exit; +} +$|=1; +$SIG{"INT"} = "fred"; kill "INT",$$; +EXPECT + +######## +# mg.c +use warnings 'uninitialized'; +'foo' =~ /(foo)/; +length $3; +EXPECT +Use of uninitialized value in length at - line 4. +######## +# mg.c +use warnings 'uninitialized'; +length $3; +EXPECT +Use of uninitialized value in length at - line 3. diff --git a/gnu/usr.bin/perl/t/lib/warnings/op b/gnu/usr.bin/perl/t/lib/warnings/op new file mode 100644 index 00000000000..011fd17beb3 --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/warnings/op @@ -0,0 +1,986 @@ + 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" + + Useless use of sort in scalar context + my $x = sort (2,1,3); + + 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/ ; + + + Parentheses missing around "my" list at -e line 1. + my $a, $b = (1,2); + + Parentheses missing around "local" list at -e line 1. + local $a, $b = (1,2); + + Bareword found in conditional at -e line 1. + use warnings 'bareword'; 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 + + defined(@array) is deprecated + (Maybe you should just omit the defined()?) + my @a ; defined @a ; + defined (@a = (1,2,3)) ; + + defined(%hash) is deprecated + (Maybe you should just omit the defined()?) + my %h ; defined %h ; + + /---/ should probably be written as "---" + join(/---/, @foo); + + %s() called too early to check prototype [Perl_peep] + fred() ; sub fred ($$) {} + + + Use of "package" with no arguments is deprecated + package; + + Package `%s' not found (did you use the incorrect case?) + + Use of /g modifier is meaningless in split + + Mandatory Warnings + ------------------ + Prototype mismatch: [cv_ckproto] + sub fred() ; + sub fred($) {} + + %s never introduced [pad_leavemy] TODO + Runaway prototype [newSUB] TODO + oops: oopsAV [oopsAV] TODO + oops: oopsHV [oopsHV] TODO + + +__END__ +# op.c +use warnings 'misc' ; +my $x ; +my $x ; +my $y = my $y ; +no warnings 'misc' ; +my $x ; +my $y ; +EXPECT +"my" variable $x masks earlier declaration in same scope at - line 4. +"my" variable $y masks earlier declaration in same statement at - line 5. +######## +# op.c +use warnings 'closure' ; +sub x { + my $x; + sub y { + $x + } + } +EXPECT +Variable "$x" will not stay shared at - line 7. +######## +# op.c +no warnings 'closure' ; +sub x { + my $x; + sub y { + $x + } + } +EXPECT + +######## +# op.c +use warnings 'closure' ; +sub x { + our $x; + sub y { + $x + } + } +EXPECT + +######## +# op.c +use warnings 'closure' ; +sub x { + my $x; + sub y { + sub { $x } + } + } +EXPECT +Variable "$x" may be unavailable at - line 6. +######## +# op.c +no warnings 'closure' ; +sub x { + my $x; + sub y { + sub { $x } + } + } +EXPECT + +######## +# op.c +use warnings 'syntax' ; +1 if $a = 1 ; +no warnings 'syntax' ; +1 if $a = 1 ; +EXPECT +Found = in conditional, should be == at - line 3. +######## +# op.c +use warnings 'deprecated' ; +split ; +no warnings 'deprecated' ; +split ; +EXPECT +Use of implicit split to @_ is deprecated at - line 3. +######## +# op.c +use warnings 'deprecated' ; +$a = split ; +no warnings 'deprecated' ; +$a = split ; +EXPECT +Use of implicit split to @_ is deprecated at - line 3. +######## +# op.c +use warnings 'deprecated'; +my (@foo, %foo); +%main::foo->{"bar"}; +%foo->{"bar"}; +@main::foo->[23]; +@foo->[23]; +$main::foo = {}; %$main::foo->{"bar"}; +$foo = {}; %$foo->{"bar"}; +$main::foo = []; @$main::foo->[34]; +$foo = []; @$foo->[34]; +no warnings 'deprecated'; +%main::foo->{"bar"}; +%foo->{"bar"}; +@main::foo->[23]; +@foo->[23]; +$main::foo = {}; %$main::foo->{"bar"}; +$foo = {}; %$foo->{"bar"}; +$main::foo = []; @$main::foo->[34]; +$foo = []; @$foo->[34]; +EXPECT +Using a hash as a reference is deprecated at - line 4. +Using a hash as a reference is deprecated at - line 5. +Using an array as a reference is deprecated at - line 6. +Using an array as a reference is deprecated at - line 7. +Using a hash as a reference is deprecated at - line 8. +Using a hash as a reference is deprecated at - line 9. +Using an array as a reference is deprecated at - line 10. +Using an array as a reference is deprecated at - line 11. +######## +# op.c +use warnings '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 (x) 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 single 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 element 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 or string 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 warnings 'void' ; close STDIN ; +my $x = sort (2,1,3); +no warnings 'void' ; +$x = sort (2,1,3); +EXPECT +Useless use of sort in scalar context at - line 3. +######## +# op.c +no warnings '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 +######## +# op.c +use warnings 'void' ; +for (@{[0]}) { "$_" } # check warning isn't duplicated +no warnings 'void' ; +for (@{[0]}) { "$_" } # check warning isn't duplicated +EXPECT +Useless use of string in void context at - line 3. +######## +# op.c +use warnings 'void' ; +use Config ; +BEGIN { + if ( ! $Config{d_telldir}) { + print <<EOM ; +SKIPPED +# telldir not present +EOM + exit + } +} +telldir 1 ; # OP_TELLDIR +no warnings 'void' ; +telldir 1 ; # OP_TELLDIR +EXPECT +Useless use of telldir in void context at - line 13. +######## +# op.c +use warnings 'void' ; +use Config ; +BEGIN { + if ( ! $Config{d_getppid}) { + print <<EOM ; +SKIPPED +# getppid not present +EOM + exit + } +} +getppid ; # OP_GETPPID +no warnings 'void' ; +getppid ; # OP_GETPPID +EXPECT +Useless use of getppid in void context at - line 13. +######## +# op.c +use warnings 'void' ; +use Config ; +BEGIN { + if ( ! $Config{d_getpgrp}) { + print <<EOM ; +SKIPPED +# getpgrp not present +EOM + exit + } +} +getpgrp ; # OP_GETPGRP +no warnings 'void' ; +getpgrp ; # OP_GETPGRP +EXPECT +Useless use of getpgrp in void context at - line 13. +######## +# op.c +use warnings 'void' ; +use Config ; +BEGIN { + if ( ! $Config{d_times}) { + print <<EOM ; +SKIPPED +# times not present +EOM + exit + } +} +times ; # OP_TMS +no warnings 'void' ; +times ; # OP_TMS +EXPECT +Useless use of times in void context at - line 13. +######## +# op.c +use warnings 'void' ; +use Config ; +BEGIN { + if ( ! $Config{d_getprior} or $^O eq 'os2') { # Locks before fixpak22 + print <<EOM ; +SKIPPED +# getpriority not present +EOM + exit + } +} +getpriority 1,2; # OP_GETPRIORITY +no warnings 'void' ; +getpriority 1,2; # OP_GETPRIORITY +EXPECT +Useless use of getpriority in void context at - line 13. +######## +# op.c +use warnings 'void' ; +use Config ; +BEGIN { + if ( ! $Config{d_getlogin}) { + print <<EOM ; +SKIPPED +# getlogin not present +EOM + exit + } +} +getlogin ; # OP_GETLOGIN +no warnings 'void' ; +getlogin ; # OP_GETLOGIN +EXPECT +Useless use of getlogin in void context at - line 13. +######## +# op.c +use warnings '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 + +no warnings 'void' ; +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 warnings 'void' ; +*a ; # OP_RV2GV +$a ; # OP_RV2SV +@a ; # OP_RV2AV +%a ; # OP_RV2HV +no warnings '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 warnings 'void' ; +"abc"; # OP_CONST +7 ; # OP_CONST +no warnings '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 warnings 'misc' ; +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/ ; +{ +no warnings 'misc' ; +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 (m//) to @array will act on scalar(@array) at - line 5. +Applying substitution (s///) to @array will act on scalar(@array) at - line 6. +Applying transliteration (tr///) to @array will act on scalar(@array) at - line 7. +Applying pattern match (m//) to @array will act on scalar(@array) at - line 8. +Applying substitution (s///) to @array will act on scalar(@array) at - line 9. +Applying transliteration (tr///) to @array will act on scalar(@array) at - line 10. +Applying pattern match (m//) to %hash will act on scalar(%hash) at - line 11. +Applying substitution (s///) to %hash will act on scalar(%hash) at - line 12. +Applying transliteration (tr///) to %hash will act on scalar(%hash) at - line 13. +Applying pattern match (m//) to %hash will act on scalar(%hash) at - line 14. +Applying substitution (s///) to %hash will act on scalar(%hash) at - line 15. +Applying transliteration (tr///) to %hash will act on scalar(%hash) at - line 16. +Can't modify private array in substitution (s///) at - line 6, near "s/a/b/ ;" +BEGIN not safe after errors--compilation aborted at - line 18. +######## +# op.c +use warnings 'syntax' ; +my $a, $b = (1,2); +no warnings 'syntax' ; +my $c, $d = (1,2); +EXPECT +Parentheses missing around "my" list at - line 3. +######## +# op.c +use warnings 'syntax' ; +local $a, $b = (1,2); +no warnings 'syntax' ; +local $c, $d = (1,2); +EXPECT +Parentheses missing around "local" list at - line 3. +######## +# op.c +use warnings 'bareword' ; +print (ABC || 1) ; +no warnings 'bareword' ; +print (ABC || 1) ; +EXPECT +Bareword found in conditional at - line 3. +######## +--FILE-- abc + +--FILE-- +# op.c +use warnings 'misc' ; +open FH, "<abc" ; +$x = 1 if $x = <FH> ; +no warnings 'misc' ; +$x = 1 if $x = <FH> ; +EXPECT +Value of <HANDLE> construct can be "0"; test with defined() at - line 4. +######## +# op.c +use warnings 'misc' ; +opendir FH, "." ; +$x = 1 if $x = readdir FH ; +no warnings 'misc' ; +$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 warnings 'misc' ; +$x = 1 if $x = <*> ; +no warnings 'misc' ; +$x = 1 if $x = <*> ; +EXPECT +Value of glob construct can be "0"; test with defined() at - line 3. +######## +# op.c +use warnings 'misc' ; +%a = (1,2,3,4) ; +$x = 1 if $x = each %a ; +no warnings 'misc' ; +$x = 1 if $x = each %a ; +EXPECT +Value of each() operator can be "0"; test with defined() at - line 4. +######## +# op.c +use warnings 'misc' ; +$x = 1 while $x = <*> and 0 ; +no warnings 'misc' ; +$x = 1 while $x = <*> and 0 ; +EXPECT +Value of glob construct can be "0"; test with defined() at - line 3. +######## +# op.c +use warnings 'misc' ; +opendir FH, "." ; +$x = 1 while $x = readdir FH and 0 ; +no warnings 'misc' ; +$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 warnings 'redefine' ; +sub fred {} +sub fred {} +no warnings 'redefine' ; +sub fred {} +EXPECT +Subroutine fred redefined at - line 4. +######## +# op.c +use warnings 'redefine' ; +sub fred () { 1 } +sub fred () { 1 } +no warnings 'redefine' ; +sub fred () { 1 } +EXPECT +Constant subroutine fred redefined at - line 4. +######## +# op.c +no warnings 'redefine' ; +sub fred () { 1 } +sub fred () { 2 } +EXPECT +Constant subroutine fred redefined at - line 4. +######## +# op.c +no warnings 'redefine' ; +sub fred () { 1 } +*fred = sub () { 2 }; +EXPECT +Constant subroutine main::fred redefined at - line 4. +######## +# op.c +use warnings 'redefine' ; +format FRED = +. +format FRED = +. +no warnings 'redefine' ; +format FRED = +. +EXPECT +Format FRED redefined at - line 5. +######## +# op.c +use warnings 'deprecated' ; +push FRED; +no warnings 'deprecated' ; +push FRED; +EXPECT +Array @FRED missing the @ in argument 1 of push() at - line 3. +######## +# op.c +use warnings 'deprecated' ; +@a = keys FRED ; +no warnings 'deprecated' ; +@a = keys FRED ; +EXPECT +Hash %FRED missing the % in argument 1 of keys() at - line 3. +######## +# op.c +BEGIN { + if ($^O eq 'MacOS') { + print <<EOM; +SKIPPED +# no exec on Mac OS +EOM + exit; + } +} +use warnings 'syntax' ; +exec "$^X -e 1" ; +my $a +EXPECT +Statement unlikely to be reached at - line 13. + (Maybe you meant system() when you said exec()?) +######## +# op.c +use warnings 'deprecated' ; +my @a; defined(@a); +EXPECT +defined(@array) is deprecated at - line 3. + (Maybe you should just omit the defined()?) +######## +# op.c +use warnings 'deprecated' ; +defined(@a = (1,2,3)); +EXPECT +defined(@array) is deprecated at - line 3. + (Maybe you should just omit the defined()?) +######## +# op.c +use warnings 'deprecated' ; +my %h; defined(%h); +EXPECT +defined(%hash) is deprecated at - line 3. + (Maybe you should just omit the defined()?) +######## +# op.c +BEGIN { + if ($^O eq 'MacOS') { + print <<EOM; +SKIPPED +# no exec on Mac OS +EOM + exit; + } +} +no warnings 'syntax' ; +exec "$^X -e 1" ; +my $a +EXPECT + +######## +# op.c +sub fred(); +sub fred($) {} +EXPECT +Prototype mismatch: sub main::fred () vs ($) at - line 3. +######## +# op.c +$^W = 0 ; +sub fred() ; +sub fred($) {} +{ + no warnings 'prototype' ; + sub Fred() ; + sub Fred($) {} + use warnings 'prototype' ; + sub freD() ; + sub freD($) {} +} +sub FRED() ; +sub FRED($) {} +EXPECT +Prototype mismatch: sub main::fred () vs ($) at - line 4. +Prototype mismatch: sub main::freD () vs ($) at - line 11. +Prototype mismatch: sub main::FRED () vs ($) at - line 14. +######## +# op.c +use warnings 'syntax' ; +join /---/, 'x', 'y', 'z'; +EXPECT +/---/ should probably be written as "---" at - line 3. +######## +# op.c [Perl_peep] +use warnings 'prototype' ; +fred() ; +sub fred ($$) {} +no warnings 'prototype' ; +joe() ; +sub joe ($$) {} +EXPECT +main::fred() called too early to check prototype at - line 3. +######## +# op.c [Perl_newATTRSUB] +--FILE-- abc.pm +use warnings 'void' ; +BEGIN { $| = 1; print "in begin\n"; } +CHECK { print "in check\n"; } +INIT { print "in init\n"; } +END { print "in end\n"; } +print "in mainline\n"; +1; +--FILE-- +use abc; +delete $INC{"abc.pm"}; +require abc; +do "abc.pm"; +EXPECT +in begin +in mainline +in check +in init +in begin +Too late to run CHECK block at abc.pm line 3. +Too late to run INIT block at abc.pm line 4. +in mainline +in begin +Too late to run CHECK block at abc.pm line 3. +Too late to run INIT block at abc.pm line 4. +in mainline +in end +in end +in end +######## +# op.c [Perl_newATTRSUB] +--FILE-- abc.pm +no warnings 'void' ; +BEGIN { $| = 1; print "in begin\n"; } +CHECK { print "in check\n"; } +INIT { print "in init\n"; } +END { print "in end\n"; } +print "in mainline\n"; +1; +--FILE-- +require abc; +do "abc.pm"; +EXPECT +in begin +in mainline +in begin +in mainline +in end +in end +######## +# op.c +my @x; +use warnings 'syntax' ; +push(@x); +unshift(@x); +no warnings 'syntax' ; +push(@x); +unshift(@x); +EXPECT +Useless use of push with no values at - line 4. +Useless use of unshift with no values at - line 5. +######## +# op.c +use warnings 'deprecated' ; +package; +no warnings 'deprecated' ; +package; +EXPECT +Use of "package" with no arguments is deprecated at - line 3. +Global symbol "BEGIN" requires explicit package name at - line 4. +BEGIN not safe after errors--compilation aborted at - line 4. +######## +# op.c +# 20020401 mjd@plover.com at suggestion of jfriedl@yahoo.com +use warnings 'regexp'; +split /blah/g, "blah"; +no warnings 'regexp'; +split /blah/g, "blah"; +EXPECT +Use of /g modifier is meaningless in split at - line 4. diff --git a/gnu/usr.bin/perl/t/lib/warnings/perl b/gnu/usr.bin/perl/t/lib/warnings/perl new file mode 100644 index 00000000000..78d730b3619 --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/warnings/perl @@ -0,0 +1,73 @@ + perl.c AOK + + gv_check(defstash) + Name \"%s::%s\" used only once: possible typo + + Mandatory Warnings All TODO + ------------------ + Recompile perl with -DDEBUGGING to use -D switch [moreswitches] + Unbalanced scopes: %ld more ENTERs than LEAVEs [perl_destruct] + Unbalanced saves: %ld more saves than restores [perl_destruct] + Unbalanced tmps: %ld more allocs than frees [perl_destruct] + Unbalanced context: %ld more PUSHes than POPs [perl_destruct] + Unbalanced string table refcount: (%d) for \"%s\" [perl_destruct] + Scalars leaked: %ld [perl_destruct] + + +__END__ +# perl.c +no warnings 'once' ; +$x = 3 ; +use warnings 'once' ; +$z = 3 ; +EXPECT +Name "main::z" used only once: possible typo at - line 5. +######## +-w +# perl.c +$x = 3 ; +no warnings 'once' ; +$z = 3 +EXPECT +Name "main::x" used only once: possible typo at - line 3. +######## +# perl.c +BEGIN { $^W =1 ; } +$x = 3 ; +no warnings 'once' ; +$z = 3 +EXPECT +Name "main::x" used only once: possible typo at - line 3. +######## +-W +# perl.c +no warnings 'once' ; +$x = 3 ; +use warnings 'once' ; +$z = 3 ; +EXPECT +OPTION random +Name "main::z" used only once: possible typo at - line 6. +Name "main::x" used only once: possible typo at - line 4. +######## +-X +# perl.c +use warnings 'once' ; +$x = 3 ; +EXPECT +######## + +# perl.c +{ use warnings 'once' ; $x = 3 ; } +$y = 3 ; +EXPECT +Name "main::x" used only once: possible typo at - line 3. +######## + +# perl.c +$z = 3 ; +BEGIN { $^W = 1 } +{ no warnings 'once' ; $x = 3 ; } +$y = 3 ; +EXPECT +Name "main::y" used only once: possible typo at - line 6. diff --git a/gnu/usr.bin/perl/t/lib/warnings/perlio b/gnu/usr.bin/perl/t/lib/warnings/perlio new file mode 100644 index 00000000000..63279ee0fe8 --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/warnings/perlio @@ -0,0 +1,58 @@ + perlio.c + + + Mandatory Warnings ALL TODO + ------------------ + Setting cnt to %d + Setting ptr %p > end+1 %p + Setting cnt to %d, ptr implies %d + + +perlio: invalid separator character %c%c%c in layer specification list %s + + open(F, ">:-aa", "bb") + + +perlio: argument list not closed for layer \"%.*s\"" + + open(F, ">:aa(", "bb") + +perlio: unknown layer \"%.*s\" + + # PerlIO/xyz.pm has 1; + open(F, ">xyz", "bb") + +__END__ + +# perlio [PerlIO_parse_layers] +no warnings 'layer'; +open(F, ">:-aa", "bb"); +use warnings 'layer'; +open(F, ">:-aa", "bb"); +close F; +EXPECT +perlio: invalid separator character '-' in layer specification list -aa at - line 6. +######## + +# perlio [PerlIO_parse_layers] +no warnings 'layer'; +open(F, ">:aa(", "bb"); +use warnings 'layer'; +open(F, ">:aa(", "bb"); +close F; +EXPECT +perlio: argument list not closed for layer "aa(" at - line 6. +######## + +--FILE-- PerlIO/xyz.pm +1; +--FILE-- +# perlio [PerlIO_parse_layers] +no warnings 'layer'; +open(F, ">:xyz", "bb"); +use warnings 'layer'; +open(F, ">:xyz", "bb"); +close F; +END { 1 while unlink "bb" } # KEEP THIS WITH THE LAST TEST. +EXPECT +perlio: unknown layer "xyz". diff --git a/gnu/usr.bin/perl/t/lib/warnings/perly b/gnu/usr.bin/perl/t/lib/warnings/perly new file mode 100644 index 00000000000..afc5dccc72f --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/warnings/perly @@ -0,0 +1,31 @@ + 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 warnings 'deprecated' ; +sub fred {} +do fred() ; +do fred(1) ; +$a = "fred" ; +do $a() ; +do $a(1) ; +no warnings 'deprecated' ; +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/gnu/usr.bin/perl/t/lib/warnings/pp b/gnu/usr.bin/perl/t/lib/warnings/pp new file mode 100644 index 00000000000..5ed7aa08916 --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/warnings/pp @@ -0,0 +1,104 @@ + pp.c TODO + + substr outside of string + $a = "ab" ; $b = substr($a, 4,5) ; + + Attempt to use reference as lvalue in substr + $a = "ab" ; $b = \$a ; substr($b, 1,1) = $b + + Use of uninitialized value in ref-to-glob cast [pp_rv2gv()] + *b = *{ undef()} + + Use of uninitialized value in scalar dereference [pp_rv2sv()] + my $a = undef ; my $b = $$a + + Odd number of elements in hash list + my $a = { 1,2,3 } ; + + Explicit blessing to '' (assuming package main) + bless \[], ""; + + Constant subroutine %s undefined + sub foo () { 1 }; undef &foo; + + Constant subroutine (anonymous) undefined + $foo = sub () { 3 }; undef &$foo; + +__END__ +# pp.c +use warnings 'substr' ; +$a = "ab" ; +$b = substr($a, 4,5) ; +no warnings 'substr' ; +$a = "ab" ; +$b = substr($a, 4,5) ; +EXPECT +substr outside of string at - line 4. +######## +# pp.c +use warnings 'substr' ; +$a = "ab" ; +$b = \$a ; +substr($b, 1,1) = "ab" ; +no warnings 'substr' ; +substr($b, 1,1) = "ab" ; +EXPECT +Attempt to use reference as lvalue in substr at - line 5. +######## +# pp.c +use warnings 'uninitialized' ; +*x = *{ undef() }; +no warnings 'uninitialized' ; +*y = *{ undef() }; +EXPECT +Use of uninitialized value in ref-to-glob cast at - line 3. +######## +# pp.c +use warnings 'uninitialized'; +$x = undef; $y = $$x; +no warnings 'uninitialized' ; +$u = undef; $v = $$u; +EXPECT +Use of uninitialized value in scalar dereference at - line 3. +######## +# pp.c +use warnings 'misc' ; +my $a = { 1,2,3}; +no warnings 'misc' ; +my $b = { 1,2,3}; +EXPECT +Odd number of elements in anonymous hash at - line 3. +######## +# pp.c +use warnings 'misc' ; +bless \[], "" ; +no warnings 'misc' ; +bless \[], "" ; +EXPECT +Explicit blessing to '' (assuming package main) at - line 3. +######## +# pp.c +use warnings 'misc'; +sub foo () { 1 } +undef &foo; +no warnings 'misc'; +sub bar () { 2 } +undef &bar; +EXPECT +Constant subroutine foo undefined at - line 4. +######## +# pp.c +use warnings 'misc'; +$foo = sub () { 3 }; +undef &$foo; +no warnings 'misc'; +$bar = sub () { 4 }; +undef &$bar; +EXPECT +Constant subroutine (anonymous) undefined at - line 4. +######## +# pp.c +use utf8 ; +$_ = "\x80 \xff" ; +reverse ; +EXPECT diff --git a/gnu/usr.bin/perl/t/lib/warnings/pp_ctl b/gnu/usr.bin/perl/t/lib/warnings/pp_ctl new file mode 100644 index 00000000000..59ced2b4460 --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/warnings/pp_ctl @@ -0,0 +1,242 @@ + 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 + { + fred() if $a++ < 200 + } + + fred() + + (in cleanup) foo bar + package Foo; + DESTROY { die "foo bar" } + { bless [], 'Foo' for 1..10 } + +__END__ +# pp_ctl.c +use warnings 'syntax' ; +format STDOUT = +@<<< @<<< +1 +. +write; +EXPECT +Not enough format arguments at - line 5. +1 +######## +# pp_ctl.c +no warnings 'syntax' ; +format = +@<<< @<<< +1 +. +write ; +EXPECT +1 +######## +# pp_ctl.c +use warnings 'exiting' ; +$_ = "abc" ; + +while ($i ++ == 0) +{ + s/ab/last/e ; +} +no warnings 'exiting' ; +while ($i ++ == 0) +{ + s/ab/last/e ; +} +EXPECT +Exiting substitution via last at - line 7. +######## +# pp_ctl.c +use warnings 'exiting' ; +sub fred { last } +{ fred() } +no warnings 'exiting' ; +sub joe { last } +{ joe() } +EXPECT +Exiting subroutine via last at - line 3. +######## +# pp_ctl.c +{ + eval "use warnings 'exiting' ; last;" +} +print STDERR $@ ; +{ + eval "no warnings 'exiting' ;last;" +} +print STDERR $@ ; +EXPECT +Exiting eval via last at (eval 1) line 1. +######## +# pp_ctl.c +use warnings 'exiting' ; +@a = (1,2) ; +@b = sort { last } @a ; +no warnings 'exiting' ; +@b = sort { last } @a ; +EXPECT +Exiting pseudo-block via last at - line 4. +Can't "last" outside a loop block at - line 4. +######## +# pp_ctl.c +use warnings 'exiting' ; +$_ = "abc" ; +fred: +while ($i ++ == 0) +{ + s/ab/last fred/e ; +} +no warnings 'exiting' ; +while ($i ++ == 0) +{ + s/ab/last fred/e ; +} +EXPECT +Exiting substitution via last at - line 7. +######## +# pp_ctl.c +use warnings 'exiting' ; +sub fred { last joe } +joe: { fred() } +no warnings 'exiting' ; +sub Fred { last Joe } +Joe: { Fred() } +EXPECT +Exiting subroutine via last at - line 3. +######## +# pp_ctl.c +joe: +{ eval "use warnings 'exiting' ; last joe;" } +print STDERR $@ ; +Joe: +{ eval "no warnings 'exiting' ; last Joe;" } +print STDERR $@ ; +EXPECT +Exiting eval via last at (eval 1) line 1. +######## +# pp_ctl.c +use warnings 'exiting' ; +@a = (1,2) ; +fred: @b = sort { last fred } @a ; +no warnings 'exiting' ; +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 warnings 'recursion' ; +BEGIN { warn "PREFIX\n" ;} +sub fred +{ + fred() if $a++ < 200 +} + +fred() +EXPECT +Deep recursion on subroutine "main::fred" at - line 6. +######## +# pp_ctl.c +no warnings 'recursion' ; +BEGIN { warn "PREFIX\n" ;} +sub fred +{ + fred() if $a++ < 200 +} + +fred() +EXPECT +######## +# pp_ctl.c +use warnings 'misc' ; +package Foo; +DESTROY { die "@{$_[0]} foo bar" } +{ bless ['A'], 'Foo' for 1..10 } +{ bless ['B'], 'Foo' for 1..10 } +EXPECT + (in cleanup) A foo bar at - line 4. + (in cleanup) B foo bar at - line 4. +######## +# pp_ctl.c +no warnings 'misc' ; +package Foo; +DESTROY { die "@{$_[0]} foo bar" } +{ bless ['A'], 'Foo' for 1..10 } +{ bless ['B'], 'Foo' for 1..10 } +EXPECT +######## +# pp_ctl.c +use warnings; +eval 'print $foo'; +EXPECT +Use of uninitialized value in print at (eval 1) line 1. +######## +# pp_ctl.c +use warnings 'portable'; +eval 'use 5.6.1'; +EXPECT +v-string in use/require non-portable at (eval 1) line 2. +######## +# pp_ctl.c +use warnings 'portable'; +eval 'use v5.6.1'; +EXPECT +v-string in use/require non-portable at (eval 1) line 2. +######## +# pp_ctl.c +use warnings; +{ + no warnings; + eval 'print $foo'; +} +EXPECT diff --git a/gnu/usr.bin/perl/t/lib/warnings/pp_hot b/gnu/usr.bin/perl/t/lib/warnings/pp_hot new file mode 100644 index 00000000000..c008dd5f106 --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/warnings/pp_hot @@ -0,0 +1,328 @@ + pp_hot.c + + print() on unopened filehandle abc [pp_print] + $f = $a = "abc" ; print $f $a + + Filehandle %s opened only for input [pp_print] + print STDIN "abc" ; + + Filehandle %s opened only for output [pp_print] + $a = <STDOUT> ; + + print() on closed filehandle %s [pp_print] + close STDIN ; print STDIN "abc" ; + + uninitialized [pp_rv2av] + my $a = undef ; my @b = @$a + + uninitialized [pp_rv2hv] + my $a = undef ; my %b = %$a + + Odd number of elements in hash list [pp_aassign] + %X = (1,2,3) ; + + Reference found where even-sized list expected [pp_aassign] + $X = [ 1 ..3 ]; + + 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 + + readline() on closed filehandle %s [Perl_do_readline] + close STDIN ; $a = <STDIN>; + + readline() on closed filehandle %s [Perl_do_readline] + readline(NONESUCH); + + 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() + + Deep recursion on anonymous subroutine [Perl_sub_crush_depth] + $a = sub { &$a if $a++ < 200} &$a + + Possible Y2K bug: about to append an integer to '19' [pp_concat] + $x = "19$yy\n"; + + Use of reference "%s" as array index [pp_aelem] + $x[\1] + +__END__ +# pp_hot.c [pp_print] +use warnings 'unopened' ; +$f = $a = "abc" ; +print $f $a; +no warnings 'unopened' ; +print $f $a; +EXPECT +print() on unopened filehandle abc at - line 4. +######## +# pp_hot.c [pp_print] +use warnings 'io' ; +# There is no guarantee that STDOUT is output only, or STDIN input only. +# Certainly on some BSDs (at least FreeBSD, Darwin, BSDi) file descriptors +# 1 and 2 are opened read/write on the tty, and the IO layers may reflect this. +# So we must make our own file handle that is read only. +my $file = "./xcv" ; unlink $file ; +open (FH, ">$file") or die $! ; +close FH or die $! ; +die "There is no file $file" unless -f $file ; +open (FH, "<$file") or die $! ; +print FH "anc" ; +open(FOO, "<&FH") or die $! ; +print FOO "anc" ; +no warnings 'io' ; +print FH "anc" ; +print FOO "anc" ; +use warnings 'io' ; +print FH "anc" ; +print FOO "anc" ; +close (FH) or die $! ; +close (FOO) or die $! ; +unlink $file ; +EXPECT +Filehandle FH opened only for input at - line 12. +Filehandle FOO opened only for input at - line 14. +Filehandle FH opened only for input at - line 19. +Filehandle FOO opened only for input at - line 20. +######## +# pp_hot.c [pp_print] +use warnings 'closed' ; +close STDIN ; +print STDIN "anc"; +opendir STDIN, "."; +print STDIN "anc"; +closedir STDIN; +no warnings 'closed' ; +print STDIN "anc"; +opendir STDIN, "."; +print STDIN "anc"; +EXPECT +print() on closed filehandle STDIN at - line 4. +print() on closed filehandle STDIN at - line 6. + (Are you trying to call print() on dirhandle STDIN?) +######## +# pp_hot.c [pp_print] +# [ID 20020425.012] from Dave Steiner <steiner@bakerst.rutgers.edu> +# This goes segv on 5.7.3 +use warnings 'closed' ; +my $fh = *STDOUT{IO}; +close STDOUT or die "Can't close STDOUT"; +print $fh "Shouldn't print anything, but shouldn't SEGV either\n"; +EXPECT +print() on closed filehandle at - line 7. +######## +# pp_hot.c [pp_print] +package foo; +use warnings 'closed'; +open my $fh1, "nonexistent"; +print $fh1 42; +open $fh2, "nonexistent"; +print $fh2 42; +open $bar::fh3, "nonexistent"; +print $bar::fh3 42; +open bar::FH4, "nonexistent"; +print bar::FH4 42; +EXPECT +print() on closed filehandle $fh1 at - line 5. +print() on closed filehandle $fh2 at - line 7. +print() on closed filehandle $fh3 at - line 9. +print() on closed filehandle FH4 at - line 11. +######## +# pp_hot.c [pp_rv2av] +use warnings 'uninitialized' ; +my $a = undef ; +my @b = @$a; +no warnings 'uninitialized' ; +my @c = @$a; +EXPECT +Use of uninitialized value in array dereference at - line 4. +######## +# pp_hot.c [pp_rv2hv] +use warnings 'uninitialized' ; +my $a = undef ; +my %b = %$a; +no warnings 'uninitialized' ; +my %c = %$a; +EXPECT +Use of uninitialized value in hash dereference at - line 4. +######## +# pp_hot.c [pp_aassign] +use warnings 'misc' ; +my %X ; %X = (1,2,3) ; +no warnings 'misc' ; +my %Y ; %Y = (1,2,3) ; +EXPECT +Odd number of elements in hash assignment at - line 3. +######## +# pp_hot.c [pp_aassign] +use warnings 'misc' ; +my %X ; %X = [1 .. 3] ; +no warnings 'misc' ; +my %Y ; %Y = [1 .. 3] ; +EXPECT +Reference found where even-sized list expected at - line 3. +######## +# pp_hot.c [Perl_do_readline] +use warnings 'closed' ; +close STDIN ; $a = <STDIN> ; +opendir STDIN, "." ; $a = <STDIN> ; +closedir STDIN; +no warnings 'closed' ; +opendir STDIN, "." ; $a = <STDIN> ; +$a = <STDIN> ; +EXPECT +readline() on closed filehandle STDIN at - line 3. +readline() on closed filehandle STDIN at - line 4. + (Are you trying to call readline() on dirhandle STDIN?) +######## +# pp_hot.c [Perl_do_readline] +use warnings 'io' ; +my $file = "./xcv" ; unlink $file ; +open (FH, ">$file") or die $! ; +my $a = <FH> ; +no warnings 'io' ; +$a = <FH> ; +use warnings 'io' ; +open(FOO, ">&FH") or die $! ; +$a = <FOO> ; +no warnings 'io' ; +$a = <FOO> ; +use warnings 'io' ; +$a = <FOO> ; +$a = <FH> ; +close (FH) or die $! ; +close (FOO) or die $! ; +unlink $file ; +EXPECT +Filehandle FH opened only for output at - line 5. +Filehandle FOO opened only for output at - line 10. +Filehandle FOO opened only for output at - line 14. +Filehandle FH opened only for output at - line 15. +######## +# pp_hot.c [Perl_sub_crush_depth] +use warnings 'recursion' ; +sub fred +{ + fred() if $a++ < 200 +} +{ + local $SIG{__WARN__} = sub { + die "ok\n" if $_[0] =~ /^Deep recursion on subroutine "main::fred"/ + }; + fred(); +} +EXPECT +ok +######## +# pp_hot.c [Perl_sub_crush_depth] +no warnings 'recursion' ; +sub fred +{ + fred() if $a++ < 200 +} +{ + local $SIG{__WARN__} = sub { + die "ok\n" if $_[0] =~ /^Deep recursion on subroutine "main::fred"/ + }; + fred(); +} +EXPECT + +######## +# pp_hot.c [Perl_sub_crush_depth] +use warnings 'recursion' ; +$b = sub +{ + &$b if $a++ < 200 +} ; + +&$b ; +EXPECT +Deep recursion on anonymous subroutine at - line 5. +######## +# pp_hot.c [Perl_sub_crush_depth] +no warnings 'recursion' ; +$b = sub +{ + &$b if $a++ < 200 +} ; + +&$b ; +EXPECT +######## +# pp_hot.c [pp_concat] +use warnings 'uninitialized'; +my($x, $y); +sub a { shift } +a($x . "x"); # should warn once +a($x . $y); # should warn twice +$x .= $y; # should warn once +$y .= $y; # should warn once +EXPECT +Use of uninitialized value in concatenation (.) or string at - line 5. +Use of uninitialized value in concatenation (.) or string at - line 6. +Use of uninitialized value in concatenation (.) or string at - line 6. +Use of uninitialized value in concatenation (.) or string at - line 7. +Use of uninitialized value in concatenation (.) or string at - line 8. +######## +# pp_hot.c [pp_concat] +use warnings 'y2k'; +use Config; +BEGIN { + unless ($Config{ccflags} =~ /Y2KWARN/) { + print "SKIPPED\n# perl not built with -DPERL_Y2KWARN"; + exit 0; + } +} +my $x; +my $yy = 78; +$x = "19$yy\n"; +$x = "19" . $yy . "\n"; +$x = "319$yy\n"; +$x = "319" . $yy . "\n"; +$yy = 19; +$x = "ok $yy\n"; +$yy = 9; +$x = 1 . $yy; +no warnings 'y2k'; +$x = "19$yy\n"; +$x = "19" . $yy . "\n"; +EXPECT +Possible Y2K bug: about to append an integer to '19' at - line 12. +Possible Y2K bug: about to append an integer to '19' at - line 13. +######## +# pp_hot.c [pp_aelem] +{ +use warnings 'misc'; +print $x[\1]; +} +{ +no warnings 'misc'; +print $x[\1]; +} + +EXPECT +OPTION regex +Use of reference ".*" as array index at - line 4. +######## +# pp_hot.c [pp_aelem] +package Foo;use overload q("") => sub {};package main;$a = bless {}, "Foo"; +$b = {}; +{ +use warnings 'misc'; +print $x[$a]; +print $x[$b]; +} +{ +no warnings 'misc'; +print $x[$a]; +print $x[$b]; +} + +EXPECT +OPTION regex +Use of reference ".*" as array index at - line 7. diff --git a/gnu/usr.bin/perl/t/lib/warnings/pp_pack b/gnu/usr.bin/perl/t/lib/warnings/pp_pack new file mode 100644 index 00000000000..62fa6ecfc73 --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/warnings/pp_pack @@ -0,0 +1,95 @@ + pp.c TODO + + 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") ; + +__END__ +# pp_pack.c +use warnings 'pack' ; +use warnings 'unpack' ; +my @a = unpack ("A,A", "22") ; +my $a = pack ("A,A", 1,2) ; +no warnings 'pack' ; +no warnings 'unpack' ; +my @b = unpack ("A,A", "22") ; +my $b = pack ("A,A", 1,2) ; +EXPECT +Invalid type in unpack: ',' at - line 4. +Invalid type in pack: ',' at - line 5. +######## +# pp.c +use warnings 'uninitialized' ; +my $a = undef ; +my $b = $$a; +no warnings 'uninitialized' ; +my $c = $$a; +EXPECT +Use of uninitialized value in scalar dereference at - line 4. +######## +# pp_pack.c +use warnings 'pack' ; +sub foo { my $a = "a"; return $a . $a++ . $a++ } +my $a = pack("p", &foo) ; +no warnings 'pack' ; +my $b = pack("p", &foo) ; +EXPECT +Attempt to pack pointer to temporary value at - line 4. +######## +# pp.c +use warnings 'misc' ; +bless \[], "" ; +no warnings 'misc' ; +bless \[], "" ; +EXPECT +Explicit blessing to '' (assuming package main) at - line 3. +######## +# pp.c +use utf8 ; +$_ = "\x80 \xff" ; +reverse ; +EXPECT +######## +# pp_pack.c +use warnings 'pack' ; +print unpack("C", pack("C", -1)), "\n", + unpack("C", pack("C", 0)), "\n", + unpack("C", pack("C", 255)), "\n", + unpack("C", pack("C", 256)), "\n", + unpack("c", pack("c", -129)), "\n", + unpack("c", pack("c", -128)), "\n", + unpack("c", pack("c", 127)), "\n", + unpack("c", pack("c", 128)), "\n"; +no warnings 'pack' ; +print unpack("C", pack("C", -1)), "\n"; +print unpack("C", pack("C", 0)), "\n"; +print unpack("C", pack("C", 255)), "\n"; +print unpack("C", pack("C", 256)), "\n"; +print unpack("c", pack("c", -129)), "\n"; +print unpack("c", pack("c", -128)), "\n"; +print unpack("c", pack("c", 127)), "\n"; +print unpack("c", pack("c", 128)), "\n"; +EXPECT +Character in "C" format wrapped at - line 3. +Character in "C" format wrapped at - line 3. +Character in "c" format wrapped at - line 3. +Character in "c" format wrapped at - line 3. +255 +0 +255 +0 +127 +-128 +127 +-128 +255 +0 +255 +0 +127 +-128 +127 +-128 diff --git a/gnu/usr.bin/perl/t/lib/warnings/pp_sys b/gnu/usr.bin/perl/t/lib/warnings/pp_sys new file mode 100644 index 00000000000..be8bb6244c2 --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/warnings/pp_sys @@ -0,0 +1,439 @@ + pp_sys.c AOK + + untie attempted while %d inner references still exist [pp_untie] + sub TIESCALAR { bless [] } ; tie $a, 'main'; untie $a ; + + fileno() on unopened filehandle abc [pp_fileno] + $a = "abc"; fileno($a) + + binmode() on unopened filehandle abc [pp_binmode] + $a = "abc"; fileno($a) + + printf() on unopened filehandle abc [pp_prtf] + $a = "abc"; printf $a "fred" + + Filehandle %s opened only for input [pp_leavewrite] + format STDIN = + . + write STDIN; + + write() on closed filehandle %s [pp_leavewrite] + format STDIN = + . + close STDIN; + write STDIN ; + + page overflow [pp_leavewrite] + + printf() on unopened filehandle abc [pp_prtf] + $a = "abc"; printf $a "fred" + + Filehandle %s opened only for input [pp_prtf] + $a = "abc"; + printf $a "fred" + + printf() on closed filehandle %s [pp_prtf] + close STDIN ; + printf STDIN "fred" + + syswrite() on closed filehandle %s [pp_send] + close STDIN; + syswrite STDIN, "fred", 1; + + send() on closed socket %s [pp_send] + close STDIN; + send STDIN, "fred", 1 + + bind() on closed socket %s [pp_bind] + close STDIN; + bind STDIN, "fred" ; + + + connect() on closed socket %s [pp_connect] + close STDIN; + connect STDIN, "fred" ; + + listen() on closed socket %s [pp_listen] + close STDIN; + listen STDIN, 2; + + accept() on closed socket %s [pp_accept] + close STDIN; + accept "fred", STDIN ; + + shutdown() on closed socket %s [pp_shutdown] + close STDIN; + shutdown STDIN, 0; + + setsockopt() on closed socket %s [pp_ssockopt] + getsockopt() on closed socket %s [pp_ssockopt] + close STDIN; + setsockopt STDIN, 1,2,3; + getsockopt STDIN, 1,2; + + getsockname() on closed socket %s [pp_getpeername] + getpeername() on closed socket %s [pp_getpeername] + close STDIN; + getsockname STDIN; + getpeername STDIN; + + flock() on closed socket %s [pp_flock] + flock() on closed socket [pp_flock] + close STDIN; + flock STDIN, 8; + flock $a, 8; + + warn(warn_nl, "stat"); [pp_stat] + + -T on closed filehandle %s + stat() on closed filehandle %s + close STDIN ; -T STDIN ; stat(STDIN) ; + + warn(warn_nl, "open"); [pp_fttext] + -T "abc\ndef" ; + + Filehandle %s opened only for output [pp_sysread] + my $file = "./xcv" ; + open(F, ">$file") ; + my $a = sysread(F, $a,10) ; + + lstat on filehandle %s [pp_lstat] + + getc() on unopened filehandle [pp_getc] + + getc() on closed filehandle [pp_getc] + +__END__ +# pp_sys.c [pp_untie] +use warnings 'untie' ; +sub TIESCALAR { bless [] } ; +$b = tie $a, 'main'; +untie $a ; +no warnings 'untie' ; +$c = tie $d, 'main'; +untie $d ; +EXPECT +untie attempted while 1 inner references still exist at - line 5. +######## +# pp_sys.c [pp_leavewrite] +use warnings 'io' ; +format STDIN = +. +write STDIN; +no warnings 'io' ; +write STDIN; +EXPECT +Filehandle STDIN opened only for input at - line 5. +######## +# pp_sys.c [pp_leavewrite] +use warnings 'closed' ; +format STDIN = +. +close STDIN; +write STDIN; +opendir STDIN, "."; +write STDIN; +closedir STDIN; +no warnings 'closed' ; +write STDIN; +opendir STDIN, "."; +write STDIN; +EXPECT +write() on closed filehandle STDIN at - line 6. +write() on closed filehandle STDIN at - line 8. + (Are you trying to call write() on dirhandle STDIN?) +######## +# pp_sys.c [pp_leavewrite] +use warnings 'io' ; +format STDOUT_TOP = +abc +. +format STDOUT = +def +ghi +. +$= = 1 ; +$- =1 ; +open STDOUT, ">".($^O eq 'VMS'? 'NL:' : '/dev/null') ; +write ; +no warnings 'io' ; +write ; +EXPECT +page overflow at - line 13. +######## +# pp_sys.c [pp_prtf] +use warnings 'unopened' ; +$a = "abc"; +printf $a "fred"; +no warnings 'unopened' ; +printf $a "fred"; +EXPECT +printf() on unopened filehandle abc at - line 4. +######## +# pp_sys.c [pp_prtf] +use warnings 'closed' ; +close STDIN ; +printf STDIN "fred"; +opendir STDIN, "."; +printf STDIN "fred"; +closedir STDIN; +no warnings 'closed' ; +printf STDIN "fred"; +opendir STDIN, "."; +printf STDIN "fred"; +EXPECT +printf() on closed filehandle STDIN at - line 4. +printf() on closed filehandle STDIN at - line 6. + (Are you trying to call printf() on dirhandle STDIN?) +######## +# pp_sys.c [pp_prtf] +use warnings 'io' ; +printf STDIN "fred"; +no warnings 'io' ; +printf STDIN "fred"; +EXPECT +Filehandle STDIN opened only for input at - line 3. +######## +# pp_sys.c [pp_send] +use warnings 'closed' ; +close STDIN; +syswrite STDIN, "fred", 1; +opendir STDIN, "."; +syswrite STDIN, "fred", 1; +closedir STDIN; +no warnings 'closed' ; +syswrite STDIN, "fred", 1; +opendir STDIN, "."; +syswrite STDIN, "fred", 1; +EXPECT +syswrite() on closed filehandle STDIN at - line 4. +syswrite() on closed filehandle STDIN at - line 6. + (Are you trying to call syswrite() on dirhandle STDIN?) +######## +# pp_sys.c [pp_flock] +use Config; +BEGIN { + if ( !$Config{d_flock} && + !$Config{d_fcntl_can_lock} && + !$Config{d_lockf} ) { + print <<EOM ; +SKIPPED +# flock not present +EOM + exit ; + } +} +use warnings qw(unopened closed); +close STDIN; +flock STDIN, 8; +opendir STDIN, "."; +flock STDIN, 8; +flock FOO, 8; +flock $a, 8; +no warnings qw(unopened closed); +flock STDIN, 8; +opendir STDIN, "."; +flock STDIN, 8; +flock FOO, 8; +flock $a, 8; +EXPECT +flock() on closed filehandle STDIN at - line 16. +flock() on closed filehandle STDIN at - line 18. + (Are you trying to call flock() on dirhandle STDIN?) +flock() on unopened filehandle FOO at - line 19. +flock() on unopened filehandle at - line 20. +######## +# 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 { + 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 "fred", STDIN; +shutdown STDIN, 0; +setsockopt STDIN, 1,2,3; +getsockopt STDIN, 1,2; +getsockname STDIN; +getpeername STDIN; +opendir STDIN, "."; +send STDIN, "fred", 1; +bind STDIN, "fred" ; +connect STDIN, "fred" ; +listen STDIN, 2; +accept "fred", STDIN; +shutdown STDIN, 0; +setsockopt STDIN, 1,2,3; +getsockopt STDIN, 1,2; +getsockname STDIN; +getpeername STDIN; +closedir STDIN; +no warnings 'io' ; +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; +opendir STDIN, "."; +send STDIN, "fred", 1; +bind STDIN, "fred" ; +connect STDIN, "fred" ; +listen STDIN, 2; +accept "fred", STDIN; +shutdown STDIN, 0; +setsockopt STDIN, 1,2,3; +getsockopt STDIN, 1,2; +getsockname STDIN; +getpeername STDIN; +EXPECT +send() on closed socket STDIN at - line 22. +bind() on closed socket STDIN at - line 23. +connect() on closed socket STDIN at - line 24. +listen() on closed socket STDIN at - line 25. +accept() on closed socket STDIN at - line 26. +shutdown() on closed socket STDIN at - line 27. +setsockopt() on closed socket STDIN at - line 28. +getsockopt() on closed socket STDIN at - line 29. +getsockname() on closed socket STDIN at - line 30. +getpeername() on closed socket STDIN at - line 31. +send() on closed socket STDIN at - line 33. + (Are you trying to call send() on dirhandle STDIN?) +bind() on closed socket STDIN at - line 34. + (Are you trying to call bind() on dirhandle STDIN?) +connect() on closed socket STDIN at - line 35. + (Are you trying to call connect() on dirhandle STDIN?) +listen() on closed socket STDIN at - line 36. + (Are you trying to call listen() on dirhandle STDIN?) +accept() on closed socket STDIN at - line 37. + (Are you trying to call accept() on dirhandle STDIN?) +shutdown() on closed socket STDIN at - line 38. + (Are you trying to call shutdown() on dirhandle STDIN?) +setsockopt() on closed socket STDIN at - line 39. + (Are you trying to call setsockopt() on dirhandle STDIN?) +getsockopt() on closed socket STDIN at - line 40. + (Are you trying to call getsockopt() on dirhandle STDIN?) +getsockname() on closed socket STDIN at - line 41. + (Are you trying to call getsockname() on dirhandle STDIN?) +getpeername() on closed socket STDIN at - line 42. + (Are you trying to call getpeername() on dirhandle STDIN?) +######## +# pp_sys.c [pp_stat] +use warnings 'newline' ; +stat "abc\ndef"; +no warnings 'newline' ; +stat "abc\ndef"; +EXPECT +Unsuccessful stat on filename containing newline at - line 3. +######## +# pp_sys.c [pp_fttext] +use warnings qw(unopened closed) ; +close STDIN ; +-T STDIN ; +stat(STDIN) ; +-T HOCUS; +stat(POCUS); +no warnings qw(unopened closed) ; +-T STDIN ; +stat(STDIN); +-T HOCUS; +stat(POCUS); +EXPECT +-T on closed filehandle STDIN at - line 4. +stat() on closed filehandle STDIN at - line 5. +-T on unopened filehandle HOCUS at - line 6. +stat() on unopened filehandle POCUS at - line 7. +######## +# 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. +######## +# pp_sys.c [pp_sysread] +use warnings 'io' ; +if ($^O eq 'dos') { + print <<EOM ; +SKIPPED +# skipped on dos +EOM + exit ; +} +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 F opened only for output at - line 12. +######## +# pp_sys.c [pp_binmode] +use warnings 'unopened' ; +binmode(BLARG); +$a = "BLERG";binmode($a); +EXPECT +binmode() on unopened filehandle BLARG at - line 3. +binmode() on unopened filehandle at - line 4. +######## +# pp_sys.c [pp_lstat] +use warnings 'io'; +open FH, "harness" or die "# $!"; +lstat FH; +open my $fh, $0 or die "# $!"; +lstat $fh; +no warnings 'io'; +lstat FH; +lstat $fh; +close FH; +close $fh; +EXPECT +lstat() on filehandle FH at - line 4. +lstat() on filehandle $fh at - line 6. +######## +# pp_sys.c [pp_getc] +use warnings qw(unopened closed) ; +getc FOO; +close STDIN; +getc STDIN; +# Create an empty file +$file = 'getcwarn.tmp'; +open FH1, ">$file" or die "# $!"; close FH1; +open FH2, $file or die "# $!"; +getc FH2; # Should not warn at EOF +close FH2; +getc FH2; # Warns, now +unlink $file; +no warnings qw(unopened closed) ; +getc FOO; +getc STDIN; +getc FH2; +EXPECT +getc() on unopened filehandle FOO at - line 3. +getc() on closed filehandle STDIN at - line 5. +getc() on closed filehandle FH2 at - line 12. diff --git a/gnu/usr.bin/perl/t/lib/warnings/regcomp b/gnu/usr.bin/perl/t/lib/warnings/regcomp new file mode 100644 index 00000000000..e9a8d70a5d9 --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/warnings/regcomp @@ -0,0 +1,218 @@ + regcomp.c AOK + + Quantifier unexpected on zero-length expression [S_study_chunk] + + (?p{}) is deprecated - use (??{}) [S_reg] + $a =~ /(?p{'x'})/ ; + + + Useless (%s%c) - %suse /%c modifier [S_reg] + Useless (%sc) - %suse /gc modifier [S_reg] + + + + Strange *+?{} on zero-length expression [S_study_chunk] + /(?=a)?/ + + %.*s matches null string many times [S_regpiece] + $a = "ABC123" ; $a =~ /(?=a)*/' + + /%.127s/: Unrecognized escape \\%c passed through [S_regatom] + $x = '\m' ; /$x/ + + POSIX syntax [%c %c] belongs inside character classes [S_checkposixcc] + + + Character class [:%.*s:] unknown [S_regpposixcc] + + Character class syntax [%c %c] belongs inside character classes [S_checkposixcc] + + /%.127s/: false [] range \"%*.*s\" in regexp [S_regclass] + + /%.127s/: false [] range \"%*.*s\" in regexp [S_regclassutf8] + + /%.127s/: Unrecognized escape \\%c in character class passed through" [S_regclass] + + /%.127s/: Unrecognized escape \\%c in character class passed through" [S_regclassutf8] + + False [] range \"%*.*s\" [S_regclass] + +__END__ +# regcomp.c [S_regpiece] +use warnings 'regexp' ; +my $a = "ABC123" ; +$a =~ /(?=a)*/ ; +no warnings 'regexp' ; +$a =~ /(?=a)*/ ; +EXPECT +(?=a)* matches null string many times in regex; marked by <-- HERE in m/(?=a)* <-- HERE / at - line 4. +######## +# regcomp.c [S_regatom] +$x = '\m' ; +use warnings 'regexp' ; +$a =~ /a$x/ ; +no warnings 'regexp' ; +$a =~ /a$x/ ; +EXPECT +Unrecognized escape \m passed through in regex; marked by <-- HERE in m/a\m <-- HERE / at - line 4. +######## +# regcomp.c [S_regpposixcc S_checkposixcc] +# +use warnings 'regexp' ; +$_ = "" ; +/[:alpha:]/; +/[:zog:]/; +no warnings 'regexp' ; +/[:alpha:]/; +/[:zog:]/; +EXPECT +POSIX syntax [: :] belongs inside character classes in regex; marked by <-- HERE in m/[:alpha:] <-- HERE / at - line 5. +POSIX syntax [: :] belongs inside character classes in regex; marked by <-- HERE in m/[:zog:] <-- HERE / at - line 6. +######## +# regcomp.c [S_checkposixcc] +# +use warnings 'regexp' ; +$_ = "" ; +/[.zog.]/; +no warnings 'regexp' ; +/[.zog.]/; +EXPECT +POSIX syntax [. .] belongs inside character classes in regex; marked by <-- HERE in m/[.zog.] <-- HERE / at - line 5. +POSIX syntax [. .] is reserved for future extensions in regex; marked by <-- HERE in m/[.zog.] <-- HERE / +######## +# regcomp.c [S_regclass] +$_ = ""; +use warnings 'regexp' ; +/[a-b]/; +/[a-\d]/; +/[\d-b]/; +/[\s-\d]/; +/[\d-\s]/; +/[a-[:digit:]]/; +/[[:digit:]-b]/; +/[[:alpha:]-[:digit:]]/; +/[[:digit:]-[:alpha:]]/; +no warnings 'regexp' ; +/[a-b]/; +/[a-\d]/; +/[\d-b]/; +/[\s-\d]/; +/[\d-\s]/; +/[a-[:digit:]]/; +/[[:digit:]-b]/; +/[[:alpha:]-[:digit:]]/; +/[[:digit:]-[:alpha:]]/; +EXPECT +False [] range "a-\d" in regex; marked by <-- HERE in m/[a-\d <-- HERE ]/ at - line 5. +False [] range "\d-" in regex; marked by <-- HERE in m/[\d- <-- HERE b]/ at - line 6. +False [] range "\s-" in regex; marked by <-- HERE in m/[\s- <-- HERE \d]/ at - line 7. +False [] range "\d-" in regex; marked by <-- HERE in m/[\d- <-- HERE \s]/ at - line 8. +False [] range "a-[:digit:]" in regex; marked by <-- HERE in m/[a-[:digit:] <-- HERE ]/ at - line 9. +False [] range "[:digit:]-" in regex; marked by <-- HERE in m/[[:digit:]- <-- HERE b]/ at - line 10. +False [] range "[:alpha:]-" in regex; marked by <-- HERE in m/[[:alpha:]- <-- HERE [:digit:]]/ at - line 11. +False [] range "[:digit:]-" in regex; marked by <-- HERE in m/[[:digit:]- <-- HERE [:alpha:]]/ at - line 12. +######## +# regcomp.c [S_regclassutf8] +BEGIN { + if (ord("\t") == 5) { + print "SKIPPED\n# ebcdic regular expression ranges differ."; + exit 0; + } +} +use utf8; +$_ = ""; +use warnings 'regexp' ; +/[a-b]/; +/[a-\d]/; +/[\d-b]/; +/[\s-\d]/; +/[\d-\s]/; +/[a-[:digit:]]/; +/[[:digit:]-b]/; +/[[:alpha:]-[:digit:]]/; +/[[:digit:]-[:alpha:]]/; +no warnings 'regexp' ; +/[a-b]/; +/[a-\d]/; +/[\d-b]/; +/[\s-\d]/; +/[\d-\s]/; +/[a-[:digit:]]/; +/[[:digit:]-b]/; +/[[:alpha:]-[:digit:]]/; +/[[:digit:]-[:alpha:]]/; +EXPECT +False [] range "a-\d" in regex; marked by <-- HERE in m/[a-\d <-- HERE ]/ at - line 12. +False [] range "\d-" in regex; marked by <-- HERE in m/[\d- <-- HERE b]/ at - line 13. +False [] range "\s-" in regex; marked by <-- HERE in m/[\s- <-- HERE \d]/ at - line 14. +False [] range "\d-" in regex; marked by <-- HERE in m/[\d- <-- HERE \s]/ at - line 15. +False [] range "a-[:digit:]" in regex; marked by <-- HERE in m/[a-[:digit:] <-- HERE ]/ at - line 16. +False [] range "[:digit:]-" in regex; marked by <-- HERE in m/[[:digit:]- <-- HERE b]/ at - line 17. +False [] range "[:alpha:]-" in regex; marked by <-- HERE in m/[[:alpha:]- <-- HERE [:digit:]]/ at - line 18. +False [] range "[:digit:]-" in regex; marked by <-- HERE in m/[[:digit:]- <-- HERE [:alpha:]]/ at - line 19. +######## +# regcomp.c [S_regclass S_regclassutf8] +use warnings 'regexp' ; +$a =~ /[a\zb]/ ; +no warnings 'regexp' ; +$a =~ /[a\zb]/ ; +EXPECT +Unrecognized escape \z in character class passed through in regex; marked by <-- HERE in m/[a\z <-- HERE b]/ at - line 3. + +######## +# regcomp.c [S_study_chunk] +use warnings 'deprecated' ; +$a = "xx" ; +$a =~ /(?p{'x'})/ ; +no warnings ; +use warnings 'regexp' ; +$a =~ /(?p{'x'})/ ; +use warnings; +no warnings 'deprecated' ; +no warnings 'regexp' ; +no warnings 'syntax' ; +$a =~ /(?p{'x'})/ ; +EXPECT +(?p{}) is deprecated - use (??{}) in regex; marked by <-- HERE in m/(?p <-- HERE {'x'})/ at - line 4. +(?p{}) is deprecated - use (??{}) in regex; marked by <-- HERE in m/(?p <-- HERE {'x'})/ at - line 7. +######## +# regcomp.c [S_reg] +use warnings 'regexp' ; +$a = qr/(?c)/; +$a = qr/(?-c)/; +$a = qr/(?g)/; +$a = qr/(?-g)/; +$a = qr/(?o)/; +$a = qr/(?-o)/; +$a = qr/(?g-o)/; +$a = qr/(?g-c)/; +$a = qr/(?o-cg)/; # (?c) means (?g) error won't be thrown +$a = qr/(?ogc)/; +no warnings 'regexp' ; +$a = qr/(?c)/; +$a = qr/(?-c)/; +$a = qr/(?g)/; +$a = qr/(?-g)/; +$a = qr/(?o)/; +$a = qr/(?-o)/; +$a = qr/(?g-o)/; +$a = qr/(?g-c)/; +$a = qr/(?o-cg)/; # (?c) means (?g) error won't be thrown +$a = qr/(?ogc)/; +#EXPECT +EXPECT +Useless (?c) - use /gc modifier in regex; marked by <-- HERE in m/(?c <-- HERE )/ at - line 3. +Useless (?-c) - don't use /gc modifier in regex; marked by <-- HERE in m/(?-c <-- HERE )/ at - line 4. +Useless (?g) - use /g modifier in regex; marked by <-- HERE in m/(?g <-- HERE )/ at - line 5. +Useless (?-g) - don't use /g modifier in regex; marked by <-- HERE in m/(?-g <-- HERE )/ at - line 6. +Useless (?o) - use /o modifier in regex; marked by <-- HERE in m/(?o <-- HERE )/ at - line 7. +Useless (?-o) - don't use /o modifier in regex; marked by <-- HERE in m/(?-o <-- HERE )/ at - line 8. +Useless (?g) - use /g modifier in regex; marked by <-- HERE in m/(?g <-- HERE -o)/ at - line 9. +Useless (?-o) - don't use /o modifier in regex; marked by <-- HERE in m/(?g-o <-- HERE )/ at - line 9. +Useless (?g) - use /g modifier in regex; marked by <-- HERE in m/(?g <-- HERE -c)/ at - line 10. +Useless (?-c) - don't use /gc modifier in regex; marked by <-- HERE in m/(?g-c <-- HERE )/ at - line 10. +Useless (?o) - use /o modifier in regex; marked by <-- HERE in m/(?o <-- HERE -cg)/ at - line 11. +Useless (?-c) - don't use /gc modifier in regex; marked by <-- HERE in m/(?o-c <-- HERE g)/ at - line 11. +Useless (?o) - use /o modifier in regex; marked by <-- HERE in m/(?o <-- HERE gc)/ at - line 12. +Useless (?g) - use /g modifier in regex; marked by <-- HERE in m/(?og <-- HERE c)/ at - line 12. +Useless (?c) - use /gc modifier in regex; marked by <-- HERE in m/(?ogc <-- HERE )/ at - line 12. diff --git a/gnu/usr.bin/perl/t/lib/warnings/regexec b/gnu/usr.bin/perl/t/lib/warnings/regexec new file mode 100644 index 00000000000..73696dfb1d6 --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/warnings/regexec @@ -0,0 +1,119 @@ + regexec.c + + This test generates "bad free" warnings when run under + PERL_DESTRUCT_LEVEL. This file merely serves as a placeholder + for investigation. + + Complex regular subexpression recursion limit (%d) exceeded + + $_ = 'a' x (2**15+1); /^()(a\1)*$/ ; + Complex regular subexpression recursion limit (%d) exceeded + + $_ = 'a' x (2**15+1); /^()(a\1)*?$/ ; + + (The actual value substituted for %d is masked in the tests so that + REG_INFTY configuration variable value does not affect outcome.) +__END__ +# regexec.c +print("SKIPPED\n# most systems run into stacksize limits\n"),exit; +use warnings 'regexp' ; +$SIG{__WARN__} = sub{local ($m) = shift; + $m =~ s/\(\d+\)/(*MASKED*)/; + print STDERR $m}; +$_ = '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 (*MASKED*) exceeded at - line 9. +######## +# regexec.c +print("SKIPPED\n# most systems run into stacksize limits\n"),exit; +no warnings 'regexp' ; +$SIG{__WARN__} = sub{local ($m) = shift; + $m =~ s/\(\d+\)/(*MASKED*)/; + print STDERR $m}; +$_ = '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 + +######## +# regexec.c +print("SKIPPED\n# most systems run into stacksize limits\n"),exit; +use warnings 'regexp' ; +$SIG{__WARN__} = sub{local ($m) = shift; + $m =~ s/\(\d+\)/(*MASKED*)/; + print STDERR $m}; +$_ = '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 (*MASKED*) exceeded at - line 9. +######## +# regexec.c +print("SKIPPED\n# most systems run into stacksize limits\n"),exit; +no warnings 'regexp' ; +$SIG{__WARN__} = sub{local ($m) = shift; + $m =~ s/\(\d+\)/(*MASKED*)/; + print STDERR $m}; +$_ = '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 + diff --git a/gnu/usr.bin/perl/t/lib/warnings/run b/gnu/usr.bin/perl/t/lib/warnings/run new file mode 100644 index 00000000000..7a4be20e704 --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/warnings/run @@ -0,0 +1,8 @@ + run.c + + + Mandatory Warnings ALL TODO + ------------------ + NULL OP IN RUN + +__END__ diff --git a/gnu/usr.bin/perl/t/lib/warnings/sv b/gnu/usr.bin/perl/t/lib/warnings/sv new file mode 100644 index 00000000000..d9aa827fc8a --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/warnings/sv @@ -0,0 +1,347 @@ + sv.c + + 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 + + Possible Y2K bug: %d format string following '19' + + Reference is already weak [Perl_sv_rvweaken] <<TODO + + Mandatory Warnings + ------------------ + Malformed UTF-8 character [sv_pos_b2u] (not tested: difficult to produce + with perl now) + + Mandatory Warnings TODO + ------------------ + Attempt to free non-arena SV: 0x%lx [del_sv] + Reference miscount in sv_replace() [sv_replace] + Attempt to free unreferenced scalar [sv_free] + Attempt to free temp prematurely: SV 0x%lx [sv_free] + semi-panic: attempt to dup freed string [newSVsv] + + +__END__ +# sv.c +use integer ; +use warnings 'uninitialized' ; +$x = 1 + $a[0] ; # a +no warnings 'uninitialized' ; +$x = 1 + $b[0] ; # a +EXPECT +Use of uninitialized value in integer addition (+) 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 warnings 'uninitialized' ; +$A *= 2 ; +no warnings 'uninitialized' ; +$A *= 2 ; +EXPECT +Use of uninitialized value in integer multiplication (*) at - line 10. +######## +# sv.c +use integer ; +use warnings 'uninitialized' ; +my $x *= 2 ; #b +no warnings 'uninitialized' ; +my $y *= 2 ; #b +EXPECT +Use of uninitialized value in integer multiplication (*) 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 warnings 'uninitialized' ; +$B = 0 ; +$B |= $A ; +no warnings 'uninitialized' ; +$B = 0 ; +$B |= $A ; +EXPECT +Use of uninitialized value in bitwise or (|) at - line 10. +######## +# sv.c +use warnings 'uninitialized' ; +my $Y = 1 ; +my $x = 1 | $a[$Y] ; +no warnings 'uninitialized' ; +my $Y = 1 ; +$x = 1 | $b[$Y] ; +EXPECT +Use of uninitialized value in bitwise or (|) at - line 4. +######## +# sv.c +use warnings 'uninitialized' ; +my $x *= 1 ; # d +no warnings 'uninitialized' ; +my $y *= 1 ; # d +EXPECT +Use of uninitialized value in multiplication (*) at - line 3. +######## +# sv.c +use warnings 'uninitialized' ; +$x = 1 + $a[0] ; # e +no warnings 'uninitialized' ; +$x = 1 + $b[0] ; # e +EXPECT +Use of uninitialized value in addition (+) 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 warnings 'uninitialized' ; +$A *= 2 ; +no warnings 'uninitialized' ; +$A *= 2 ; +EXPECT +Use of uninitialized value in multiplication (*) at - line 9. +######## +# sv.c +use warnings 'uninitialized' ; +$x = $y + 1 ; # f +no warnings 'uninitialized' ; +$x = $z + 1 ; # f +EXPECT +Use of uninitialized value in addition (+) at - line 3. +######## +# sv.c +use warnings 'uninitialized' ; +$x = chop undef ; # g +no warnings 'uninitialized' ; +$x = chop undef ; # g +EXPECT +Modification of a read-only value attempted at - line 3. +######## +# sv.c +use warnings 'uninitialized' ; +$x = chop $y ; # h +no warnings 'uninitialized' ; +$x = chop $z ; # h +EXPECT +Use of uninitialized value in scalar chop 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 warnings 'uninitialized' ; +$B = "" ; +$B .= $A ; +no warnings 'uninitialized' ; +$C = "" ; +$C .= $A ; +EXPECT +Use of uninitialized value in concatenation (.) or string at - line 10. +######## +# perlbug 20011116.125 +use warnings 'uninitialized'; +$a = undef; +$foo = join '', $a, "\n"; +$foo = "$a\n"; +$foo = "a:$a\n"; +EXPECT +Use of uninitialized value in join or string at - line 4. +Use of uninitialized value in concatenation (.) or string at - line 5. +Use of uninitialized value in concatenation (.) or string at - line 6. +######## +# sv.c +use warnings 'numeric' ; +sub TIESCALAR{bless[]} ; +sub FETCH {"def"} ; +tie $a,"main" ; +my $b = 1 + $a; +no warnings 'numeric' ; +my $c = 1 + $a; +EXPECT +Argument "def" isn't numeric in addition (+) at - line 6. +######## +# sv.c +use warnings 'numeric' ; +my $x = 1 + "def" ; +no warnings 'numeric' ; +my $z = 1 + "def" ; +EXPECT +Argument "def" isn't numeric in addition (+) at - line 3. +######## +# sv.c +use warnings 'numeric' ; +my $a = "def" ; +my $x = 1 + $a ; +no warnings 'numeric' ; +my $y = 1 + $a ; +EXPECT +Argument "def" isn't numeric in addition (+) at - line 4. +######## +# sv.c +use warnings 'numeric' ; use integer ; +my $a = "def" ; +my $x = 1 + $a ; +no warnings 'numeric' ; +my $z = 1 + $a ; +EXPECT +Argument "def" isn't numeric in integer addition (+) at - line 4. +######## +# sv.c +use warnings 'numeric' ; +my $x = 1 & "def" ; +no warnings 'numeric' ; +my $z = 1 & "def" ; +EXPECT +Argument "def" isn't numeric in bitwise and (&) at - line 3. +######## +# sv.c +use warnings 'numeric' ; +my $x = pack i => "def" ; +no warnings 'numeric' ; +my $z = pack i => "def" ; +EXPECT +Argument "def" isn't numeric in pack at - line 3. +######## +# sv.c +use warnings 'numeric' ; +my $a = "d\0f" ; +my $x = 1 + $a ; +no warnings 'numeric' ; +my $z = 1 + $a ; +EXPECT +Argument "d\0f" isn't numeric in addition (+) at - line 4. +######## +# sv.c +use warnings 'redefine' ; +sub fred {} +sub joe {} +*fred = \&joe ; +no warnings 'redefine' ; +sub jim {} +*jim = \&joe ; +EXPECT +Subroutine main::fred redefined at - line 5. +######## +# sv.c +use warnings 'printf' ; +open F, ">".($^O eq 'VMS'? 'NL:' : '/dev/null') ; +printf F "%z\n" ; +my $a = sprintf "%z" ; +printf F "%" ; +$a = sprintf "%" ; +printf F "%\x02" ; +$a = sprintf "%\x02" ; +no warnings 'printf' ; +printf F "%z\n" ; +$a = sprintf "%z" ; +printf F "%" ; +$a = sprintf "%" ; +printf F "%\x02" ; +$a = sprintf "%\x02" ; +EXPECT +Invalid conversion in sprintf: "%z" 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: "%z" at - line 4. +Invalid conversion in printf: end of string at - line 6. +Invalid conversion in printf: "%\002" at - line 8. +######## +# sv.c +use warnings 'misc' ; +*a = undef ; +no warnings 'misc' ; +*b = undef ; +EXPECT +Undefined value assigned to typeglob at - line 3. +######## +# sv.c +use warnings 'y2k'; +use Config; +BEGIN { + unless ($Config{ccflags} =~ /Y2KWARN/) { + print "SKIPPED\n# perl not built with -DPERL_Y2KWARN"; + exit 0; + } + $|=1; +} +my $x; +my $yy = 78; +$x = printf "19%02d\n", $yy; +$x = sprintf "#19%02d\n", $yy; +$x = printf " 19%02d\n", 78; +$x = sprintf "19%02d\n", 78; +$x = printf "319%02d\n", $yy; +$x = sprintf "319%02d\n", $yy; +no warnings 'y2k'; +$x = printf "19%02d\n", $yy; +$x = sprintf "19%02d\n", $yy; +$x = printf "19%02d\n", 78; +$x = sprintf "19%02d\n", 78; +EXPECT +Possible Y2K bug: %d format string following '19' at - line 16. +Possible Y2K bug: %d format string following '19' at - line 13. +1978 +Possible Y2K bug: %d format string following '19' at - line 14. +Possible Y2K bug: %d format string following '19' at - line 15. + 1978 +31978 +1978 +1978 +######## +# sv.c +use warnings 'numeric' ; +$a = "\x{100}\x{200}" * 42; +no warnings 'numeric' ; +$a = "\x{100}\x{200}" * 42; +EXPECT +Argument "\x{100}\x{200}" isn't numeric in multiplication (*) at - line 3. +######## +# sv.c +use warnings 'numeric' ; +$a = "\x{100}\x{200}"; $a = -$a; +no warnings 'numeric' ; +$a = "\x{100}\x{200}"; $a = -$a; +EXPECT +Argument "\x{100}\x{200}" isn't numeric in negation (-) at - line 3. diff --git a/gnu/usr.bin/perl/t/lib/warnings/taint b/gnu/usr.bin/perl/t/lib/warnings/taint new file mode 100644 index 00000000000..fd6deed60f9 --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/warnings/taint @@ -0,0 +1,49 @@ + taint.c AOK + + Insecure %s%s while running with -T switch + +__END__ +-T +--FILE-- abc +def +--FILE-- +# taint.c +open(FH, "<abc") ; +$a = <FH> ; +close FH ; +chdir $a ; +print "xxx\n" ; +EXPECT +Insecure dependency in chdir while running with -T switch at - line 5. +######## +-TU +--FILE-- abc +def +--FILE-- +# taint.c +open(FH, "<abc") ; +$a = <FH> ; +close FH ; +chdir $a ; +print "xxx\n" ; +EXPECT +xxx +######## +-TU +--FILE-- abc +def +--FILE-- +# taint.c +open(FH, "<abc") ; +$a = <FH> ; +close FH ; +use warnings 'taint' ; +chdir $a ; +print "xxx\n" ; +no warnings 'taint' ; +chdir $a ; +print "yyy\n" ; +EXPECT +Insecure dependency in chdir while running with -T switch at - line 6. +xxx +yyy diff --git a/gnu/usr.bin/perl/t/lib/warnings/toke b/gnu/usr.bin/perl/t/lib/warnings/toke new file mode 100644 index 00000000000..0a5346a50f8 --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/warnings/toke @@ -0,0 +1,798 @@ +toke.c AOK + + we seem to have lost a few ambiguous warnings!! + + + $a = <<; + Use of comma-less variable list is deprecated + (called 3 times via depcom) + + \1 better written as $1 + use warnings '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; + + 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) ; + + %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() + + 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 ; + + dump() better written as CORE::dump() + + Use of /c modifier is meaningless without /g + + Use of /c modifier is meaningless in s/// + + Mandatory Warnings + ------------------ + Use of "%s" without parentheses is ambiguous [check_uni] + rand + 4 + + Ambiguous use of -%s resolved as -&%s() [yylex] + sub fred {} ; - fred ; + + Precedence problem: open %.*s should be open(%.*s) [yylex] + open FOO || die; + + Operator or semicolon missing before %c%s [yylex] + Ambiguous use of %c resolved as operator %c + *foo *foo + +__END__ +# toke.c +use warnings 'deprecated' ; +format STDOUT = +@<<< @||| @>>> @>>> +$a $b "abc" 'def' +. +no warnings 'deprecated' ; +format STDOUT = +@<<< @||| @>>> @>>> +$a $b "abc" 'def' +. +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. +######## +# toke.c +use warnings 'deprecated' ; +$a = <<; + +no warnings 'deprecated' ; +$a = <<; + +EXPECT +Use of bare << to mean <<"" is deprecated at - line 3. +######## +# toke.c +use warnings 'syntax' ; +s/(abc)/\1/; +no warnings 'syntax' ; +s/(abc)/\1/; +EXPECT +\1 better written as $1 at - line 3. +######## +# toke.c +use warnings 'semicolon' ; +$a = 1 +&time ; +no warnings 'semicolon' ; +$a = 1 +&time ; +EXPECT +Semicolon seems to be missing at - line 3. +######## +# toke.c +use warnings '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 3. +Reversed -= operator at - line 4. +Reversed *= operator at - line 5. +Reversed %= operator at - line 6. +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. +syntax error at - line 8, near "=." +syntax error at - line 9, near "=^" +syntax error at - line 10, near "=|" +Unterminated <> operator at - line 11. +######## +# toke.c +no warnings 'syntax' ; +my $a =+ 2 ; +$a =- 2 ; +$a =* 2 ; +$a =% 2 ; +$a =& 2 ; +$a =. 2 ; +$a =^ 2 ; +$a =| 2 ; +$a =< 2 ; +$a =/ 2 ; +EXPECT +syntax error at - line 8, near "=." +syntax error at - line 9, near "=^" +syntax error at - line 10, near "=|" +Unterminated <> operator at - line 11. +######## +# toke.c +use warnings 'syntax' ; +my $a = $a[1,2] ; +no warnings 'syntax' ; +my $a = $a[1,2] ; +EXPECT +Multidimensional syntax $a[1,2] not supported at - line 3. +######## +# toke.c +use warnings 'syntax' ; +sub fred {} ; $SIG{TERM} = fred; +no warnings 'syntax' ; +$SIG{TERM} = fred; +EXPECT +You need to quote "fred" at - line 3. +######## +# toke.c +use warnings 'syntax' ; +@a[3] = 2; +@a{3} = 2; +no warnings '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 warnings 'syntax' ; +$_ = "ab" ; +s/(ab)/\1/e; +no warnings 'syntax' ; +$_ = "ab" ; +s/(ab)/\1/e; +EXPECT +Can't use \1 to mean $1 in expression at - line 4. +######## +# toke.c +use warnings 'reserved' ; +$a = abc; +$a = { def + +=> 1 }; +no warnings 'reserved' ; +$a = abc; +EXPECT +Unquoted string "abc" may clash with future reserved word at - line 3. +######## +# toke.c +use warnings 'qw' ; +@a = qw(a, b, c) ; +no warnings 'qw' ; +@a = qw(a, b, c) ; +EXPECT +Possible attempt to separate words with commas at - line 3. +######## +# toke.c +use warnings 'qw' ; +@a = qw(a b #) ; +no warnings 'qw' ; +@a = qw(a b #) ; +EXPECT +Possible attempt to put comments in qw() list at - line 3. +######## +# toke.c +use warnings 'syntax' ; +print ("") +EXPECT +print (...) interpreted as function at - line 3. +######## +# toke.c +no warnings 'syntax' ; +print ("") +EXPECT + +######## +# toke.c +use warnings 'syntax' ; +printf ("") +EXPECT +printf (...) interpreted as function at - line 3. +######## +# toke.c +no warnings 'syntax' ; +printf ("") +EXPECT + +######## +# toke.c +use warnings 'syntax' ; +sort ("") +EXPECT +sort (...) interpreted as function at - line 3. +######## +# toke.c +no warnings 'syntax' ; +sort ("") +EXPECT + +######## +# toke.c +use warnings 'ambiguous' ; +$a = ${time[2]}; +no warnings 'ambiguous' ; +$a = ${time[2]}; +EXPECT +Ambiguous use of ${time[...]} resolved to $time[...] at - line 3. +######## +# toke.c +use warnings 'ambiguous' ; +$a = ${time{2}}; +EXPECT +Ambiguous use of ${time{...}} resolved to $time{...} at - line 3. +######## +# toke.c +no warnings 'ambiguous' ; +$a = ${time{2}}; +EXPECT + +######## +# toke.c +use warnings 'ambiguous' ; +$a = ${time} ; +no warnings 'ambiguous' ; +$a = ${time} ; +EXPECT +Ambiguous use of ${time} resolved to $time at - line 3. +######## +# toke.c +use warnings 'ambiguous' ; +sub fred {} +$a = ${fred} ; +no warnings 'ambiguous' ; +$a = ${fred} ; +EXPECT +Ambiguous use of ${fred} resolved to $fred at - line 4. +######## +# toke.c +use warnings 'syntax' ; +$a = _123; print "$a\n"; #( 3 string) +$a = 1_23; print "$a\n"; +$a = 12_3; print "$a\n"; +$a = 123_; print "$a\n"; # 6 +$a = _+123; print "$a\n"; # 7 string) +$a = +_123; print "$a\n"; #( 8 string) +$a = +1_23; print "$a\n"; +$a = +12_3; print "$a\n"; +$a = +123_; print "$a\n"; # 11 +$a = _-123; print "$a\n"; #(12 string) +$a = -_123; print "$a\n"; #(13 string) +$a = -1_23; print "$a\n"; +$a = -12_3; print "$a\n"; +$a = -123_; print "$a\n"; # 16 +$a = 123._456; print "$a\n"; # 17 +$a = 123.4_56; print "$a\n"; +$a = 123.45_6; print "$a\n"; +$a = 123.456_; print "$a\n"; # 20 +$a = +123._456; print "$a\n"; # 21 +$a = +123.4_56; print "$a\n"; +$a = +123.45_6; print "$a\n"; +$a = +123.456_; print "$a\n"; # 24 +$a = -123._456; print "$a\n"; # 25 +$a = -123.4_56; print "$a\n"; +$a = -123.45_6; print "$a\n"; +$a = -123.456_; print "$a\n"; # 28 +$a = 123.456E_12; printf("%.0f\n", $a); # 29 +$a = 123.456E1_2; printf("%.0f\n", $a); +$a = 123.456E12_; printf("%.0f\n", $a); # 31 +$a = 123.456E_+12; printf("%.0f\n", $a); # 32 +$a = 123.456E+_12; printf("%.0f\n", $a); # 33 +$a = 123.456E+1_2; printf("%.0f\n", $a); +$a = 123.456E+12_; printf("%.0f\n", $a); # 35 +$a = 123.456E_-12; print "$a\n"; # 36 +$a = 123.456E-_12; print "$a\n"; # 37 +$a = 123.456E-1_2; print "$a\n"; +$a = 123.456E-12_; print "$a\n"; # 39 +$a = 1__23; print "$a\n"; # 40 +$a = 12.3__4; print "$a\n"; # 41 +$a = 12.34e1__2; printf("%.0f\n", $a); # 42 +no warnings 'syntax' ; +$a = _123; print "$a\n"; +$a = 1_23; print "$a\n"; +$a = 12_3; print "$a\n"; +$a = 123_; print "$a\n"; +$a = _+123; print "$a\n"; +$a = +_123; print "$a\n"; +$a = +1_23; print "$a\n"; +$a = +12_3; print "$a\n"; +$a = +123_; print "$a\n"; +$a = _-123; print "$a\n"; +$a = -_123; print "$a\n"; +$a = -1_23; print "$a\n"; +$a = -12_3; print "$a\n"; +$a = -123_; print "$a\n"; +$a = 123._456; print "$a\n"; +$a = 123.4_56; print "$a\n"; +$a = 123.45_6; print "$a\n"; +$a = 123.456_; print "$a\n"; +$a = +123._456; print "$a\n"; +$a = +123.4_56; print "$a\n"; +$a = +123.45_6; print "$a\n"; +$a = +123.456_; print "$a\n"; +$a = -123._456; print "$a\n"; +$a = -123.4_56; print "$a\n"; +$a = -123.45_6; print "$a\n"; +$a = -123.456_; print "$a\n"; +$a = 123.456E_12; printf("%.0f\n", $a); +$a = 123.456E1_2; printf("%.0f\n", $a); +$a = 123.456E12_; printf("%.0f\n", $a); +$a = 123.456E_+12; printf("%.0f\n", $a); +$a = 123.456E+_12; printf("%.0f\n", $a); +$a = 123.456E+1_2; printf("%.0f\n", $a); +$a = 123.456E+12_; printf("%.0f\n", $a); +$a = 123.456E_-12; print "$a\n"; +$a = 123.456E-_12; print "$a\n"; +$a = 123.456E-1_2; print "$a\n"; +$a = 123.456E-12_; print "$a\n"; +$a = 1__23; print "$a\n"; +$a = 12.3__4; print "$a\n"; +$a = 12.34e1__2; printf("%.0f\n", $a); +EXPECT +OPTIONS regex +Misplaced _ in number at - line 6. +Misplaced _ in number at - line 11. +Misplaced _ in number at - line 16. +Misplaced _ in number at - line 17. +Misplaced _ in number at - line 20. +Misplaced _ in number at - line 21. +Misplaced _ in number at - line 24. +Misplaced _ in number at - line 25. +Misplaced _ in number at - line 28. +Misplaced _ in number at - line 29. +Misplaced _ in number at - line 31. +Misplaced _ in number at - line 32. +Misplaced _ in number at - line 33. +Misplaced _ in number at - line 35. +Misplaced _ in number at - line 36. +Misplaced _ in number at - line 37. +Misplaced _ in number at - line 39. +Misplaced _ in number at - line 40. +Misplaced _ in number at - line 41. +Misplaced _ in number at - line 42. +_123 +123 +123 +123 +123 +_123 +123 +123 +123 +-123 +-_123 +-123 +-123 +-123 +123.456 +123.456 +123.456 +123.456 +123.456 +123.456 +123.456 +123.456 +-123.456 +-123.456 +-123.456 +-123.456 +123456000000000 +123456000000000 +123456000000000 +123456000000000 +123456000000000 +123456000000000 +123456000000000 +1.23456e-0?10 +1.23456e-0?10 +1.23456e-0?10 +1.23456e-0?10 +123 +12.34 +12340000000000 +_123 +123 +123 +123 +123 +_123 +123 +123 +123 +-123 +-_123 +-123 +-123 +-123 +123.456 +123.456 +123.456 +123.456 +123.456 +123.456 +123.456 +123.456 +-123.456 +-123.456 +-123.456 +-123.456 +123456000000000 +123456000000000 +123456000000000 +123456000000000 +123456000000000 +123456000000000 +123456000000000 +1.23456e-0?10 +1.23456e-0?10 +1.23456e-0?10 +1.23456e-0?10 +123 +12.34 +12340000000000 +######## +# toke.c +use warnings 'bareword' ; +#line 25 "bar" +$a = FRED:: ; +no warnings 'bareword' ; +#line 25 "bar" +$a = FRED:: ; +EXPECT +Bareword "FRED::" refers to nonexistent package at bar line 25. +######## +# toke.c +use warnings 'ambiguous' ; +sub time {} +my $a = time() ; +no warnings 'ambiguous' ; +my $b = time() ; +EXPECT +Ambiguous call resolved as CORE::time(), qualify as such or use & at - line 4. +######## +# toke.c +use warnings ; +eval <<'EOE'; +# line 30 "foo" +warn "yelp"; +{ + $_ = " \x{123} " ; +} +EOE +EXPECT +yelp at foo line 30. +######## +# toke.c +my $a = rand + 4 ; +EXPECT +Warning: Use of "rand" without parens is ambiguous at - line 2. +######## +# toke.c +$^W = 0 ; +my $a = rand + 4 ; +{ + no warnings 'ambiguous' ; + $a = rand + 4 ; + use warnings 'ambiguous' ; + $a = rand + 4 ; +} +$a = rand + 4 ; +EXPECT +Warning: Use of "rand" without parens is ambiguous at - line 3. +Warning: Use of "rand" without parens is ambiguous at - line 8. +Warning: Use of "rand" without parens is ambiguous at - line 10. +######## +# toke.c +sub fred {}; +-fred ; +EXPECT +Ambiguous use of -fred resolved as -&fred() at - line 3. +######## +# toke.c +$^W = 0 ; +sub fred {} ; +-fred ; +{ + no warnings 'ambiguous' ; + -fred ; + use warnings 'ambiguous' ; + -fred ; +} +-fred ; +EXPECT +Ambiguous use of -fred resolved as -&fred() at - line 4. +Ambiguous use of -fred resolved as -&fred() at - line 9. +Ambiguous use of -fred resolved as -&fred() at - line 11. +######## +# toke.c +open FOO || time; +EXPECT +Precedence problem: open FOO should be open(FOO) at - line 2. +######## +# toke.c +$^W = 0 ; +open FOO || time; +{ + no warnings 'precedence' ; + open FOO || time; + use warnings 'precedence' ; + open FOO || time; +} +open FOO || time; +EXPECT +Precedence problem: open FOO should be open(FOO) at - line 3. +Precedence problem: open FOO should be open(FOO) at - line 8. +Precedence problem: open FOO should be open(FOO) at - line 10. +######## +# toke.c +$^W = 0 ; +*foo *foo ; +{ + no warnings 'ambiguous' ; + *foo *foo ; + use warnings 'ambiguous' ; + *foo *foo ; +} +*foo *foo ; +EXPECT +Operator or semicolon missing before *foo at - line 3. +Ambiguous use of * resolved as operator * at - line 3. +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. +######## +# toke.c +use warnings 'misc' ; +my $a = "\m" ; +no warnings 'misc' ; +$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 = 0b10000000000000000000000000000000000000000000000000000000000000000 ; + $a = 0x0fffffffe ; + $a = 0x0ffffffff ; + $a = 0x10000000000000000 ; + $a = 0037777777776 ; + $a = 0037777777777 ; + $a = 002000000000000000000000; +no warnings 'overflow' ; + $a = 0b011111111111111111111111111111110 ; + $a = 0b011111111111111111111111111111111 ; + $a = 0b10000000000000000000000000000000000000000000000000000000000000000 ; + $a = 0x0fffffffe ; + $a = 0x0ffffffff ; + $a = 0x10000000000000000 ; + $a = 0037777777776 ; + $a = 0037777777777 ; + $a = 002000000000000000000000; +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. +######## +# toke.c +BEGIN { $^C = 1; } +use warnings 'misc'; +dump; +CORE::dump; +EXPECT +dump() better written as CORE::dump() at - line 4. +- syntax OK +######## +# toke.c +use warnings 'misc'; +use subs qw/dump/; +sub dump { print "no warning for overriden dump\n"; } +dump; +EXPECT +no warning for overriden dump +######## +# toke.c +use warnings 'ambiguous'; +"@mjd_previously_unused_array"; +no warnings 'ambiguous'; +"@mjd_previously_unused_array"; +EXPECT +Possible unintended interpolation of @mjd_previously_unused_array in string at - line 3. +######## +# toke.c +# The \q should warn, the \_ should NOT warn. +use warnings 'misc'; +"foo" =~ /\q/; +"bar" =~ /\_/; +no warnings 'misc'; +"foo" =~ /\q/; +"bar" =~ /\_/; +EXPECT +Unrecognized escape \q passed through at - line 4. +######## +# toke.c +# 20020328 mjd-perl-patch+@plover.com at behest of jfriedl@yahoo.com +use warnings 'regexp'; +"foo" =~ /foo/c; +"foo" =~ /foo/cg; +no warnings 'regexp'; +"foo" =~ /foo/c; +"foo" =~ /foo/cg; +EXPECT +Use of /c modifier is meaningless without /g at - line 4. +######## +# toke.c +# 20020328 mjd-perl-patch+@plover.com at behest of jfriedl@yahoo.com +use warnings 'regexp'; +$_ = "ab" ; +s/ab/ab/c; +s/ab/ab/cg; +no warnings 'regexp'; +s/ab/ab/c; +s/ab/ab/cg; +EXPECT +Use of /c modifier is meaningless in s/// at - line 5. +Use of /c modifier is meaningless in s/// at - line 6. +######## +-wa +# toke.c +# 20020414 mjd-perl-patch+@plover.com # -a flag should suppress these warnings +print "@F\n"; +EXPECT + +######## +-w +# toke.c +# 20020414 mjd-perl-patch+@plover.com # -a flag should suppress these warnings +print "@F\n"; +EXPECT +Possible unintended interpolation of @F in string at - line 4. +Name "main::F" used only once: possible typo at - line 4. +######## +-wa +# toke.c +# 20020414 mjd-perl-patch+@plover.com +EXPECT + +######## +# toke.c +# 20020414 mjd-perl-patch+@plover.com +# In 5.7.3, this emitted "Possible unintended interpolation" warnings +use warnings 'ambiguous'; +$s = "(@-)(@+)"; +EXPECT + + diff --git a/gnu/usr.bin/perl/t/lib/warnings/universal b/gnu/usr.bin/perl/t/lib/warnings/universal new file mode 100644 index 00000000000..d9b1883532d --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/warnings/universal @@ -0,0 +1,14 @@ + universal.c AOK + + Can't locate package %s for @%s::ISA [S_isa_lookup] + + + +__END__ +# universal.c [S_isa_lookup] +use warnings 'misc' ; +@ISA = qw(Joe) ; +my $a = bless [] ; +UNIVERSAL::isa $a, Jim ; +EXPECT +Can't locate package Joe for @main::ISA at - line 5. diff --git a/gnu/usr.bin/perl/t/lib/warnings/utf8 b/gnu/usr.bin/perl/t/lib/warnings/utf8 new file mode 100644 index 00000000000..6635f02d755 --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/warnings/utf8 @@ -0,0 +1,136 @@ + + utf8.c AOK + + [utf8_to_uv] + Malformed UTF-8 character + my $a = ord "\x80" ; + + Malformed UTF-8 character + my $a = ord "\xf080" ; + <<<<<< this warning can't be easily triggered from perl anymore + + [utf16_to_utf8] + Malformed UTF-16 surrogate + <<<<<< Add a test when somethig actually calls utf16_to_utf8 + +__END__ +# utf8.c [utf8_to_uv] -W +BEGIN { + if (ord('A') == 193) { + print "SKIPPED\n# ebcdic platforms do not generate Malformed UTF-8 warnings."; + exit 0; + } +} +use utf8 ; +my $a = "snstorm" ; +{ + no warnings 'utf8' ; + my $a = "snstorm"; + use warnings 'utf8' ; + my $a = "snstorm"; +} +EXPECT +Malformed UTF-8 character (unexpected non-continuation byte 0x73, immediately after start byte 0xf8) at - line 9. +Malformed UTF-8 character (unexpected non-continuation byte 0x73, immediately after start byte 0xf8) at - line 14. +######## +use warnings 'utf8'; +my $d7ff = chr(0xD7FF); +my $d800 = chr(0xD800); +my $dfff = chr(0xDFFF); +my $e000 = chr(0xE000); +my $feff = chr(0xFEFF); +my $fffd = chr(0xFFFD); +my $fffe = chr(0xFFFE); +my $ffff = chr(0xFFFF); +my $hex4 = chr(0x10000); +my $hex5 = chr(0x100000); +my $maxm1 = chr(0x10FFFE); +my $max = chr(0x10FFFF); +no warnings 'utf8'; +my $d7ff = chr(0xD7FF); +my $d800 = chr(0xD800); +my $dfff = chr(0xDFFF); +my $e000 = chr(0xE000); +my $feff = chr(0xFEFF); +my $fffd = chr(0xFFFD); +my $fffe = chr(0xFFFE); +my $ffff = chr(0xFFFF); +my $hex4 = chr(0x10000); +my $hex5 = chr(0x100000); +my $maxm1 = chr(0x10FFFE); +my $max = chr(0x10FFFF); +EXPECT +UTF-16 surrogate 0xd800 at - line 3. +UTF-16 surrogate 0xdfff at - line 4. +Unicode character 0xfffe is illegal at - line 8. +Unicode character 0xffff is illegal at - line 9. +Unicode character 0x10fffe is illegal at - line 12. +Unicode character 0x10ffff is illegal at - line 13. +######## +use warnings 'utf8'; +my $d7ff = pack("U", 0xD7FF); +my $d800 = pack("U", 0xD800); +my $dfff = pack("U", 0xDFFF); +my $e000 = pack("U", 0xE000); +my $feff = pack("U", 0xFEFF); +my $fffd = pack("U", 0xFFFD); +my $fffe = pack("U", 0xFFFE); +my $ffff = pack("U", 0xFFFF); +my $hex4 = pack("U", 0x10000); +my $hex5 = pack("U", 0x100000); +my $maxm1 = pack("U", 0x10FFFE); +my $max = pack("U", 0x10FFFF); +no warnings 'utf8'; +my $d7ff = pack("U", 0xD7FF); +my $d800 = pack("U", 0xD800); +my $dfff = pack("U", 0xDFFF); +my $e000 = pack("U", 0xE000); +my $feff = pack("U", 0xFEFF); +my $fffd = pack("U", 0xFFFD); +my $fffe = pack("U", 0xFFFE); +my $ffff = pack("U", 0xFFFF); +my $hex4 = pack("U", 0x10000); +my $hex5 = pack("U", 0x100000); +my $maxm1 = pack("U", 0x10FFFE); +my $max = pack("U", 0x10FFFF); +EXPECT +UTF-16 surrogate 0xd800 at - line 3. +UTF-16 surrogate 0xdfff at - line 4. +Unicode character 0xfffe is illegal at - line 8. +Unicode character 0xffff is illegal at - line 9. +Unicode character 0x10fffe is illegal at - line 12. +Unicode character 0x10ffff is illegal at - line 13. +######## +use warnings 'utf8'; +my $d7ff = "\x{D7FF}"; +my $d800 = "\x{D800}"; +my $dfff = "\x{DFFF}"; +my $e000 = "\x{E000}"; +my $feff = "\x{FEFF}"; +my $fffd = "\x{FFFD}"; +my $fffe = "\x{FFFE}"; +my $ffff = "\x{FFFF}"; +my $hex4 = "\x{10000}"; +my $hex5 = "\x{100000}"; +my $maxm1 = "\x{10FFFE}"; +my $max = "\x{10FFFF}"; +no warnings 'utf8'; +my $d7ff = "\x{D7FF}"; +my $d800 = "\x{D800}"; +my $dfff = "\x{DFFF}"; +my $e000 = "\x{E000}"; +my $feff = "\x{FEFF}"; +my $fffd = "\x{FFFD}"; +my $fffe = "\x{FFFE}"; +my $ffff = "\x{FFFF}"; +my $hex4 = "\x{10000}"; +my $hex5 = "\x{100000}"; +my $maxm1 = "\x{10FFFE}"; +my $max = "\x{10FFFF}"; +EXPECT +UTF-16 surrogate 0xd800 at - line 3. +UTF-16 surrogate 0xdfff at - line 4. +Unicode character 0xfffe is illegal at - line 8. +Unicode character 0xffff is illegal at - line 9. +Unicode character 0x10fffe is illegal at - line 12. +Unicode character 0x10ffff is illegal at - line 13. diff --git a/gnu/usr.bin/perl/t/lib/warnings/util b/gnu/usr.bin/perl/t/lib/warnings/util new file mode 100644 index 00000000000..4e960c1ea19 --- /dev/null +++ b/gnu/usr.bin/perl/t/lib/warnings/util @@ -0,0 +1,158 @@ + util.c AOK + + Illegal octal digit ignored + my $a = oct "029" ; + + Illegal hex digit ignored + my $a = hex "0xv9" ; + + 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 "077777777777777777777777777777" ; + 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' ; +$a = oct "029" ; +EXPECT +Illegal octal digit '9' ignored at - line 3. +######## +# util.c +use warnings 'digit' ; +my $a = hex "0xv9" ; +no warnings 'digit' ; +$a = hex "0xv9" ; +EXPECT +Illegal hexadecimal digit 'v' ignored at - line 3. +######## +# util.c +use warnings 'digit' ; +my $a = oct "0b9" ; +no warnings 'digit' ; +$a = oct "0b9" ; +EXPECT +Illegal binary digit '9' ignored at - line 3. +######## +# util.c +use warnings 'overflow' ; +my $a = oct "0b11111111111111111111111111111111111111111111111111111111111111111"; +no warnings 'overflow' ; +$a = oct "0b11111111111111111111111111111111111111111111111111111111111111111"; +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 "077777777777777777777777777777" ; +no warnings 'overflow' ; +$a = oct "077777777777777777777777777777" ; +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. +######## +# util.c +use warnings; +$x = 1; +if ($x) { + print $y; +} +EXPECT +Name "main::y" used only once: possible typo at - line 5. +Use of uninitialized value in print at - line 5. +######## +# util.c +use warnings; +$x = 1; +if ($x) { + $x++; + print $y; +} +EXPECT +Name "main::y" used only once: possible typo at - line 6. +Use of uninitialized value in print at - line 6. +######## +# util.c +use warnings; +$x = 0; +if ($x) { + print "1\n"; +} elsif (!$x) { + print $y; +} else { + print "0\n"; +} +EXPECT +Name "main::y" used only once: possible typo at - line 7. +Use of uninitialized value in print at - line 7. +######## +# util.c +use warnings; +$x = 0; +if ($x) { + print "1\n"; +} elsif (!$x) { + $x++; + print $y; +} else { + print "0\n"; +} +EXPECT +Name "main::y" used only once: possible typo at - line 8. +Use of uninitialized value in print at - line 8. |